/[cvs]/nfo/perl/libs/Data/Transfer/Sync/Core.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Transfer/Sync/Core.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by joko, Sun Feb 9 05:01:10 2003 UTC revision 1.6 by joko, Fri Feb 14 14:03:49 2003 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.6  2003/02/14 14:03:49  joko
10    ##    + logging, debugging
11    ##    - refactored code to sister module
12    ##
13    ##    Revision 1.5  2003/02/11 05:30:47  joko
14    ##    + minor fixes and some debugging mud
15    ##
16  ##    Revision 1.4  2003/02/09 05:01:10  joko  ##    Revision 1.4  2003/02/09 05:01:10  joko
17  ##    + major structure changes  ##    + major structure changes
18  ##    - refactored code to sister modules  ##    - refactored code to sister modules
# Line 83  use misc::HashExt; Line 90  use misc::HashExt;
90  use Data::Compare::Struct qw( getDifference isEmpty );  use Data::Compare::Struct qw( getDifference isEmpty );
91  use Data::Storage::Container;  use Data::Storage::Container;
92  use DesignPattern::Object;  use DesignPattern::Object;
93    use libdb qw( quotesql );
94    
95  # get logger instance  # get logger instance
96  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 113  sub _init { Line 121  sub _init {
121      $self->{container}->addStorage($_, $self->{storages}->{$_});      $self->{container}->addStorage($_, $self->{storages}->{$_});
122    }    }
123        
124      # trace
125        #print Dumper($self);
126        #exit;
127    
128    return 1;    return 1;
129        
130  }  }
# Line 178  sub _run { Line 190  sub _run {
190    # iterate through set    # iterate through set
191    foreach my $source_node_real (@results) {    foreach my $source_node_real (@results) {
192    
193        print ":" if $self->{verbose};
194    
195      $tc->{total}++;      $tc->{total}++;
196    
197  #print "========================  iter", "\n";  #print "========================  iter", "\n";
# Line 187  sub _run { Line 201  sub _run {
201      #   - is a "deep_copy" needed here if occouring modifications take place?      #   - is a "deep_copy" needed here if occouring modifications take place?
202      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
203      #   - after all, just take care for now that this object doesn't get updated!      #   - after all, just take care for now that this object doesn't get updated!
204        #   - so, just use its reference for now - if some cloning is needed in future, do this here!
205      my $source_node = $source_node_real;      my $source_node = $source_node_real;
206    
207      # modify entry - handle new style callbacks (the readers)      # modify entry - handle new style callbacks (the readers)
208  #print Dumper($source_node);  
209  #exit;      # trace
210          #print Dumper($source_node);
211          #exit;
212    
213      my $descent = 'source';      my $descent = 'source';
214    
# Line 199  sub _run { Line 216  sub _run {
216      my $map_callbacks = {};      my $map_callbacks = {};
217      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
218    
219          # trace
220            #print Dumper($callbacks);
221            #exit;
222    
223        my $error = 0;        my $error = 0;
224    
225        foreach my $node (keys %{$callbacks->{read}}) {        foreach my $node (keys %{$callbacks->{read}}) {
# Line 206  sub _run { Line 227  sub _run {
227          my $object = $source_node;          my $object = $source_node;
228          my $value; # = $source_node->{$node};          my $value; # = $source_node->{$node};
229    
230          # trace
231            #print Dumper($self->{options});
232    
233          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
234          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
235          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
# Line 213  sub _run { Line 237  sub _run {
237          #print $evalstring, "\n"; exit;          #print $evalstring, "\n"; exit;
238          my $cb_result = eval($evalstring);          my $cb_result = eval($evalstring);
239          if ($@) {          if ($@) {
           die $@;  
240            $error = 1;            $error = 1;
241            print $@, "\n";            $logger->error( __PACKAGE__ . "->_run: $@" );
242              next;
243          }          }
244          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
245                    
# Line 225  sub _run { Line 249  sub _run {
249    
250      }      }
251    
252  #print Dumper($source_node);      # trace
253          #print Dumper($source_node);
254    
255      # exclude defined fields  (simply delete from object)      # exclude defined fields  (simply delete from object)
256      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
# Line 234  sub _run { Line 259  sub _run {
259      $self->{node} = {};      $self->{node} = {};
260      $self->{node}->{source}->{payload} = $source_node;      $self->{node}->{source}->{payload} = $source_node;
261    
262  #print "res - ident", "\n";      # trace
263          #print Dumper($self->{node});
264          #exit;
265    
266      # determine ident of entry      # determine ident of entry
267      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
# Line 256  sub _run { Line 283  sub _run {
283    
284  #print "checksum", "\n";  #print "checksum", "\n";
285            
     print ":" if $self->{verbose};  
   
286      #print Dumper($self);      #print Dumper($self);
287            
288      # determine status of entry by synchronization method      # determine status of entry by synchronization method
# Line 290  sub _run { Line 315  sub _run {
315        # determine if entry is "new" or "dirty"        # determine if entry is "new" or "dirty"
316        # after all, this seems to be the point where the hammer falls.....        # after all, this seems to be the point where the hammer falls.....
317        print "c" if $self->{verbose};        print "c" if $self->{verbose};
318  #print Dumper($self->{node});  
319  #exit;        # trace
320            #print Dumper($self->{node});
321            #exit;
322    
323        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
324        if (!$self->{node}->{status}->{new}) {        if (!$self->{node}->{status}->{new}) {
325          $self->{node}->{status}->{dirty} =          $self->{node}->{status}->{dirty} =
# Line 319  sub _run { Line 347  sub _run {
347      $self->buildAttributeMap();      $self->buildAttributeMap();
348    
349    
350  #print Dumper($self->{node}); exit;      # trace
351          #print Dumper($self->{node}); exit;
352  #print "attempt", "\n";        #print "attempt", "\n";
353    
354      # additional (new) checks for feature "write-protection"      # additional (new) checks for feature "write-protection"
355      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
# Line 334  sub _run { Line 362  sub _run {
362        next;        next;
363      }      }
364    
365  #print Dumper($self);      # trace
366  #exit;        #print Dumper($self);
367          #exit;
368    
369      # transfer contents of map to target      # transfer contents of map to target
370      if ($self->{node}->{status}->{new}) {      if ($self->{node}->{status}->{new}) {
# Line 371  sub _run { Line 400  sub _run {
400            
401      # change ident in source (take from target), if transfer was ok and target is an IdentAuthority      # change ident in source (take from target), if transfer was ok and target is an IdentAuthority
402      # this is (for now) called a "retransmit" indicated by a "r"-character when verbosing      # this is (for now) called a "retransmit" indicated by a "r"-character when verbosing
403      if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {      #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
404        if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
405        print "r" if $self->{verbose};        print "r" if $self->{verbose};
406        #print Dumper($self->{meta});        #print Dumper($self->{meta});
407        #print Dumper($self->{node});        #print Dumper($self->{node});
# Line 449  sub _dumpCompact { Line 479  sub _dumpCompact {
479  sub _doTransferToTarget {  sub _doTransferToTarget {
480    my $self = shift;    my $self = shift;
481    my $action = shift;    my $action = shift;
482    #print Dumper($self->{node});      
483    #exit;    # trace
484        #print Dumper($self->{meta});
485        #print Dumper($self->{node});
486        #exit;
487        
488    $self->_modifyNode('target', $action, $self->{node}->{map});    $self->_modifyNode('target', $action, $self->{node}->{map});
489  }  }
490    
# Line 568  sub _otherSide { Line 602  sub _otherSide {
602    return '';    return '';
603  }  }
604    
 sub _erase_all {  
   my $self = shift;  
   my $descent = shift;  
   #my $node = shift;  
   my $node = $self->{meta}->{$descent}->{node};  
   $self->{meta}->{$descent}->{storage}->eraseAll($node);  
 }  
605    
606  1;  1;
607    __END__
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed