--- nfo/perl/libs/Data/Transfer/Sync.pm	2002/11/29 04:45:50	1.1
+++ nfo/perl/libs/Data/Transfer/Sync.pm	2002/12/05 08:06:05	1.5
@@ -1,4 +1,4 @@
-##    $Id: Sync.pm,v 1.1 2002/11/29 04:45:50 joko Exp $
+##    $Id: Sync.pm,v 1.5 2002/12/05 08:06:05 joko Exp $
 ##
 ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
 ##
@@ -6,6 +6,25 @@
 ##
 ##    ----------------------------------------------------------------------------------------
 ##    $Log: Sync.pm,v $
+##    Revision 1.5  2002/12/05 08:06:05  joko
+##    + bugfix with determining empty fields (Null) with DBD::CSV
+##    + debugging
+##    + updated comments
+##
+##    Revision 1.4  2002/12/03 15:54:07  joko
+##    + {import}-flag is now {prepare}-flag
+##
+##    Revision 1.3  2002/12/01 22:26:59  joko
+##    + minor cosmetics for logging
+##
+##    Revision 1.2  2002/12/01 04:43:25  joko
+##    + mapping deatil entries may now be either an ARRAY or a HASH
+##    + erase flag is used now (for export-operations)
+##    + expressions to refer to values inside deep nested structures
+##    - removed old mappingV2-code
+##    + cosmetics
+##    + sub _erase_all
+##
 ##    Revision 1.1  2002/11/29 04:45:50  joko
 ##    + initial check in
 ##
@@ -23,7 +42,7 @@
 use misc::HashExt;
 use libp qw( md5_base64 );
 use libdb qw( quotesql hash2Sql );
-use Data::Transform::OO qw( hash2object );
+use Data::Transform::Deep qw( hash2object refexpr2perlref );
 use Data::Compare::Struct qw( getDifference isEmpty );
 
 # get logger instance
@@ -147,11 +166,28 @@
   $logger->info( __PACKAGE__ . "->syncNodes: source=$self->{meta}->{source}->{dbkey}/$self->{meta}->{source}->{node} $direction_arrow target=$self->{meta}->{target}->{dbkey}/$self->{meta}->{target}->{node}" );
 
   # build mapping
+  # incoming: and Array of node map entries (Array or Hash) - e.g.
+  #   [ 'source:item_name' => 'target:class_val' ]
+  #   { source => 'event->startDateTime', target => 'begindate' }
   foreach (@{$self->{args}->{mapping}}) {
-    my @key1 = split(':', $_->[0]);
-    my @key2 = split(':', $_->[1]);
-    push @{$self->{meta}->{$key1[0]}->{childnodes}}, $key1[1];
-    push @{$self->{meta}->{$key2[0]}->{childnodes}}, $key2[1];
+    if (ref $_ eq 'ARRAY') {
+      my @entry1 = split(':', $_->[0]);
+      my @entry2 = split(':', $_->[1]);
+      my $descent = [];
+      my $node = [];
+      $descent->[0] = $entry1[0];
+      $descent->[1] = $entry2[0];
+      $node->[0] = $entry1[1];
+      $node->[1] = $entry2[1];
+      push @{$self->{meta}->{$descent->[0]}->{childnodes}}, $node->[0];
+      push @{$self->{meta}->{$descent->[1]}->{childnodes}}, $node->[1];
+    } elsif (ref $_ eq 'HASH') {
+      foreach my $entry_key (keys %$_) {
+        my $entry_val = $_->{$entry_key};
+        push @{$self->{meta}->{$entry_key}->{childnodes}}, $entry_val;
+      }
+    }
+
   }
 
   # check partners/nodes: does partner exist / is node available?
@@ -185,13 +221,21 @@
 
   # import flag means: prepare the source node to be syncable
   # this is useful if there are e.g. no "ident" or "checksum" columns yet inside a DBI like (row-based) storage
-  if ($self->{args}->{import}) {
+  if ($self->{args}->{prepare}) {
     $self->_prepareNode_MetaProperties('source');
     $self->_prepareNode_DummyIdent('source');
     #return;
     #$self->_erase_all($opts->{source_node});
   }
   
+  # erase flag means: erase the target
+  #if ($opts->{erase}) {
+  if ($self->{args}->{erase}) {
+    # TODO: move this method to the scope of the synchronization core and wrap it around different handlers
+    #print "ERASE", "\n";
+    $self->_erase_all('target');
+  }
+
   $self->_syncNodes();
 
 }
@@ -216,7 +260,7 @@
     $results ||= $self->_getNodeList('source', $filter);
   }
   
-  # get reference to node list from convenient method provided by corehandle
+  # get reference to node list from convenient method provided by CORE-HANDLE
   #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});
   #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});
   $results ||= $self->_getNodeList('source');
@@ -294,14 +338,18 @@
     my $identOK = $self->_resolveNodeIdent('source');
     #if (!$identOK && lc $self->{args}->{direction} ne 'import') {
     if (!$identOK) {
-      $logger->critical( __PACKAGE__ . "->syncNodes: Can not synchronize: No ident found in source node, maybe try to \"import\" this node first." );
+      #print Dumper($self->{meta}->{source});
+      $logger->critical( __PACKAGE__ . "->syncNodes: No ident found in source node \"$self->{meta}->{source}->{node}\", try to \"prepare\" this node first?" );
       return;
     }
 
 #print "statload", "\n";
 #print "ident: ", $self->{node}->{source}->{ident}, "\n";
+#print Dumper($self->{node});
     
     my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});
+
+#print Dumper($self->{node});
     
     # mark node as new either if there's no ident or if stat/load failed
     if (!$statOK) {
@@ -388,6 +436,7 @@
       $tc->{attempt_new}++;
       $self->_doTransferToTarget('insert');
       # asymmetry: refetch node from target to re-calculate new ident and checksum (TODO: is IdentAuthority of relevance here?)
+      #print Dumper($self->{node});
       $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);
       $self->_readChecksum('target');
 
@@ -413,11 +462,11 @@
     # change ident in source (take from target), if transfer was ok and target is an IdentAuthority
     # this is (for now) called a "retransmit" indicated by a "r"-character when verbosing
     if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {
+      print "r" if $self->{verbose};
       #print Dumper($self->{meta});
       #print Dumper($self->{node});
       #exit;
       $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});
-      print "r" if $self->{verbose};
     }
 
     print ":" if $self->{verbose};
@@ -427,11 +476,11 @@
   print "\n" if $self->{verbose};
   
   # build user-message from some stats
-    my $msg = "stats: $tc";
+    my $msg = "statistics: $tc";
     
     if ($tc->{error_per_row}) {
       $msg .= "\n";
-      $msg .= "errors:" . "\n";
+      $msg .= "errors from \"error_per_row\":" . "\n";
       $msg .= Dumper($tc->{error_per_row});
     }
     
@@ -455,30 +504,35 @@
     my $item = {};
     foreach my $key (keys %$_) {
       my $val = $_->{$key};
+
+#print Dumper($val);
+
       if (ref $val eq 'Set::Object') {
         #print "========================= SET", "\n";
-        #print Dumper($val);
+#print Dumper($val);
         #print Dumper($val->members());
         #$val = $val->members();
         #$vars->[$count]->{$key} = $val->members() if $val->can("members");
         #$item->{$key} = $val->members() if $val->can("members");
         $item->{$key} = $val->members();
         #print Dumper($vars->[$count]->{$key});
+
       } else {
         $item->{$key} = $val;
       }
+
     }
     push @data, $item;
     $count++;
   }
 
-#print "Dump:", "\n";
-#print Dumper(@data);
+#print "Dump:", Dumper(@data), "\n";
 
   $Data::Dumper::Indent = 0;
   my $result = Dumper(@data);
   $Data::Dumper::Indent = 2;
   return $result;
+  
 }
 
 
@@ -572,6 +626,9 @@
       for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
         #my $map_right = $self->{args}->{mapping}->{$key};
         
+        $self->{node}->{source}->{propcache} = {};
+        $self->{node}->{target}->{propcache} = {};
+        
         # get property name
         $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
         $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];
@@ -589,13 +646,39 @@
           $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};
         }
         #$self->{node}->{map}->{$key} = $value;
+        
+        # detect expression
+        # for transferring deeply nested structures described by expressions
+        #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
+        if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
+          
+          # create an anonymous sub to act as callback target dispatcher
+            my $cb_dispatcher = sub {
+              #print "===============  CALLBACK DISPATCHER", "\n";
+              #print "ident: ", $self->{node}->{source}->{ident}, "\n";
+              #return $self->{node}->{source}->{ident};
+              
+            };
+          
+
+#print Dumper($self->{node});
+          
+          # build callback map for helper function
+          #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
+          my $cbmap = {};
+          my $value = refexpr2perlref($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
+          $self->{node}->{source}->{propcache}->{value} = $value;
+        }
 
         # encode values dependent on type of underlying storage here - expand cases...
         my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
         if ($storage_type eq 'DBI') {
           # ...for sql
           $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
-        } elsif ($storage_type eq 'Tangram') {
+        }
+         elsif ($storage_type eq 'Tangram') {
+          # iso? utf8 already possible?
+        
         } elsif ($storage_type eq 'LDAP') {
           # TODO: encode utf8 here?
         }
@@ -606,35 +689,6 @@
       }
     }
 
-#print "self->{entry}: ", Dumper($self->{node}), "\n"; exit;
-
-    # for transferring deeply nested structures described by expressions
-    # this currently does not work!
-    # TODO: re-enable this!
-    if ($self->{args}->{mappingV2}) {
-      
-      # apply mapping from $self->{args}->{mappingV2} to $self->{node}->{map}
-      foreach my $mapStep (@{$self->{args}->{mappingV2}}) {
-        
-        # prepare left/right keys/values
-        my $left_key = $mapStep->{left};
-        my $left_val = _resolveMapStepExpr( $self->{node}->{source}->{payload}, $mapStep->{left} );
-        my $right_key = $mapStep->{right};
-        my $right_val = ( $mapStep->{right} );
-        #print "map: $map_right", "\n";
-        
-        if ($mapStep->{method}) {
-          if ($mapStep->{method} eq 'v:1') {
-            $left_val = $left_key;
-          }
-        }
-
-        #$self->{node}->{map}->{$key} = $value;
-        #if ( grep(!/$right_key/, @{$self->{args}->{exclude}}) ) {
-          $self->{node}->{map}->{$right_key} = $self->{R}->quoteSql($left_val);
-        #}
-      }
-    }
     
   # TODO: $logger->dump( ... );
   #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
@@ -708,6 +762,8 @@
     }
   }
   
+  
+  #print Dumper($self->{meta});
 
   # DBI speaks SQL
   if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {
@@ -809,13 +865,17 @@
       hash2object($object, $map);
 
       # ... and re-update@orm.
+#print Dumper($object);
       $self->{meta}->{$descent}->{storage}->update($object);
 
       # asymmetry: get ident after insert
       # TODO:
       #   - just do this if it is an IdentAuthority
       #   - use IdentProvider metadata here
-      $self->{node}->{$descent}->{ident} = $self->{meta}->{$descent}->{storage}->id($object);
+#print Dumper($self->{meta}->{$descent});
+      my $oid = $self->{meta}->{$descent}->{storage}->id($object);
+#print "oid: $oid", "\n";
+      $self->{node}->{$descent}->{ident} = $oid;
 
 
     } elsif (lc $action eq 'update') {
@@ -912,6 +972,11 @@
       #print "\n", "Attempt to fetch entry implicitely by ident failed: no ident given! This may result in an insert if no write-protection is in the way.", "\n";
       return;
     }
+    
+    # patch for DBD::CSV
+    if ($ident && $ident eq 'Null') {
+      return;
+    }
 
     my $result = $self->{meta}->{$descent}->{storage}->sendQuery({ 
       node => $self->{meta}->{$descent}->{node}, 
@@ -926,21 +991,38 @@
     my $entry = $result->getNextEntry();
     my $status = $result->getStatus();
 
+#print Dumper($status);
+    
     # TODO: enhance error handling (store inside tc)
     #if (!$row) {
     #  print "\n", "row error", "\n";
     #  next;
     #}
-    if (($status && $status->{err}) || !$entry) {
-      #$logger->critical( __PACKAGE__ . "->_loadNode (ident=\"$ident\") failed" );
-      return;
-    }
+
+    # these checks run before actually loading payload- and meta-data to node-container
+    
+      # 1st level - hard error
+      if ($status && $status->{err}) {
+        $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - hard error (that's ok)" );
+        return;
+      }
+  
+      # 2nd level - logical (empty/notfound) error
+      if (($status && $status->{empty}) || !$entry) {
+        $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - logical error (that's ok)" );
+        #print "no entry (logical)", "\n";
+        return;
+      }
+
+#print Dumper($entry);
+
     # was:
     # $self->{node}->{$descent}->{ident} = $ident;  
     # is:
-    # TODO: re-resolve ident from entry via metadata "IdentProvider"
+    # TODO: re-resolve ident from entry via metadata "IdentProvider" here - like elsewhere
     $self->{node}->{$descent}->{ident} = $ident;
     $self->{node}->{$descent}->{payload} = $entry;
+
   }
   
   return 1;
@@ -964,9 +1046,11 @@
     $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,
     cs => $self->{node}->{target}->{checksum},
   };
-  #print Dumper($map);
-  #print Dumper($self->{node});
-  #exit;
+
+#print Dumper($map);
+#print Dumper($self->{node});
+#exit;
+
   $self->_modifyNode('source', 'update', $map);
 }
 
@@ -1048,6 +1132,10 @@
     }
     my $crit = join ' AND ', @crits;
     print "p" if $self->{verbose};
+
+#print Dumper($map);
+#print Dumper($crit);
+
     $self->_modifyNode($descent, 'update', $map, $crit);
     $i++;
   }
@@ -1063,12 +1151,20 @@
 # TODO: handle this in an abstract way (wipe out use of 'source' and/or 'target' inside core)
 sub _otherSide {
   my $self = shift;
-  my $side = shift;
-  return 'source' if $side eq 'target';
-  return 'target' if $side eq 'source';
+  my $descent = shift;
+  return 'source' if $descent eq 'target';
+  return 'target' if $descent eq 'source';
   return '';
 }
 
+sub _erase_all {
+  my $self = shift;
+  my $descent = shift;
+  #my $node = shift;
+  my $node = $self->{meta}->{$descent}->{node};
+  $self->{meta}->{$descent}->{storage}->eraseAll($node);
+}
+
 
 =pod