--- nfo/perl/libs/Data/Transfer/Sync/Core.pm	2003/02/09 05:01:10	1.4
+++ nfo/perl/libs/Data/Transfer/Sync/Core.pm	2003/02/11 05:30:47	1.5
@@ -1,4 +1,4 @@
-##    $Id: Core.pm,v 1.4 2003/02/09 05:01:10 joko Exp $
+##    $Id: Core.pm,v 1.5 2003/02/11 05:30:47 joko Exp $
 ##
 ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
 ##
@@ -6,6 +6,9 @@
 ##
 ##    ----------------------------------------------------------------------------------------
 ##    $Log: Core.pm,v $
+##    Revision 1.5  2003/02/11 05:30:47  joko
+##    + minor fixes and some debugging mud
+##
 ##    Revision 1.4  2003/02/09 05:01:10  joko
 ##    + major structure changes
 ##    - refactored code to sister modules
@@ -83,6 +86,7 @@
 use Data::Compare::Struct qw( getDifference isEmpty );
 use Data::Storage::Container;
 use DesignPattern::Object;
+use libdb qw( quotesql );
 
 # get logger instance
 my $logger = Log::Dispatch::Config->instance;
@@ -113,6 +117,10 @@
     $self->{container}->addStorage($_, $self->{storages}->{$_});
   }
   
+  # trace
+    #print Dumper($self);
+    #exit;
+
   return 1;
   
 }
@@ -178,6 +186,8 @@
   # iterate through set
   foreach my $source_node_real (@results) {
 
+    print ":" if $self->{verbose};
+
     $tc->{total}++;
 
 #print "========================  iter", "\n";
@@ -187,6 +197,7 @@
     #   - is a "deep_copy" needed here if occouring modifications take place?
     #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
     #   - after all, just take care for now that this object doesn't get updated!
+    #   - so, just use its reference for now - if some cloning is needed in future, do this here!
     my $source_node = $source_node_real;
 
     # modify entry - handle new style callbacks (the readers)
@@ -199,6 +210,10 @@
     my $map_callbacks = {};
     if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
 
+      # trace
+        #print Dumper($callbacks);
+        #exit;
+
       my $error = 0;
 
       foreach my $node (keys %{$callbacks->{read}}) {
@@ -206,6 +221,8 @@
         my $object = $source_node;
         my $value; # = $source_node->{$node};
 
+#print Dumper($self->{options});
+
         # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
         #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
         my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
@@ -213,9 +230,11 @@
         #print $evalstring, "\n"; exit;
         my $cb_result = eval($evalstring);
         if ($@) {
-          die $@;
+          #die $@;
+          $logger->error( __PACKAGE__ . "->_run: $@" );
           $error = 1;
-          print $@, "\n";
+          #print $@, "\n";
+          return;
         }
         # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
         
@@ -225,7 +244,8 @@
 
     }
 
-#print Dumper($source_node);
+    # trace
+      #print Dumper($source_node);
 
     # exclude defined fields  (simply delete from object)
     map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
@@ -234,7 +254,9 @@
     $self->{node} = {};
     $self->{node}->{source}->{payload} = $source_node;
 
-#print "res - ident", "\n";
+    # trace
+      #print Dumper($self->{node});
+      #exit;
 
     # determine ident of entry
     my $identOK = $self->_resolveNodeIdent('source');
@@ -256,8 +278,6 @@
 
 #print "checksum", "\n";
     
-    print ":" if $self->{verbose};
-
     #print Dumper($self);
     
     # determine status of entry by synchronization method
@@ -290,8 +310,11 @@
       # determine if entry is "new" or "dirty"
       # after all, this seems to be the point where the hammer falls.....
       print "c" if $self->{verbose};
-#print Dumper($self->{node});
-#exit;
+
+      # trace
+        #print Dumper($self->{node});
+        #exit;
+
       $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
       if (!$self->{node}->{status}->{new}) {
         $self->{node}->{status}->{dirty} = 
@@ -319,9 +342,9 @@
     $self->buildAttributeMap();
 
 
-#print Dumper($self->{node}); exit;
-
-#print "attempt", "\n";
+    # trace
+      #print Dumper($self->{node}); exit;
+      #print "attempt", "\n";
 
     # additional (new) checks for feature "write-protection"
     if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
@@ -334,8 +357,9 @@
       next;
     }
 
-#print Dumper($self);
-#exit;
+    # trace
+      #print Dumper($self);
+      #exit;
 
     # transfer contents of map to target
     if ($self->{node}->{status}->{new}) {
@@ -371,7 +395,8 @@
     
     # 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->{options}->{target}->{storage}->{idAuthority}) {
+    #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
+    if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
       print "r" if $self->{verbose};
       #print Dumper($self->{meta});
       #print Dumper($self->{node});
@@ -449,8 +474,12 @@
 sub _doTransferToTarget {
   my $self = shift;
   my $action = shift;
-  #print Dumper($self->{node});
-  #exit;
+    
+  # trace
+    #print Dumper($self->{meta});
+    #print Dumper($self->{node});
+    #exit;
+    
   $self->_modifyNode('target', $action, $self->{node}->{map});
 }