/[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.5 by joko, Tue Feb 11 05:30:47 2003 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.5  2003/02/11 05:30:47  joko
10    ##    + minor fixes and some debugging mud
11    ##
12  ##    Revision 1.4  2003/02/09 05:01:10  joko  ##    Revision 1.4  2003/02/09 05:01:10  joko
13  ##    + major structure changes  ##    + major structure changes
14  ##    - refactored code to sister modules  ##    - refactored code to sister modules
# Line 83  use misc::HashExt; Line 86  use misc::HashExt;
86  use Data::Compare::Struct qw( getDifference isEmpty );  use Data::Compare::Struct qw( getDifference isEmpty );
87  use Data::Storage::Container;  use Data::Storage::Container;
88  use DesignPattern::Object;  use DesignPattern::Object;
89    use libdb qw( quotesql );
90    
91  # get logger instance  # get logger instance
92  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 113  sub _init { Line 117  sub _init {
117      $self->{container}->addStorage($_, $self->{storages}->{$_});      $self->{container}->addStorage($_, $self->{storages}->{$_});
118    }    }
119        
120      # trace
121        #print Dumper($self);
122        #exit;
123    
124    return 1;    return 1;
125        
126  }  }
# Line 178  sub _run { Line 186  sub _run {
186    # iterate through set    # iterate through set
187    foreach my $source_node_real (@results) {    foreach my $source_node_real (@results) {
188    
189        print ":" if $self->{verbose};
190    
191      $tc->{total}++;      $tc->{total}++;
192    
193  #print "========================  iter", "\n";  #print "========================  iter", "\n";
# Line 187  sub _run { Line 197  sub _run {
197      #   - is a "deep_copy" needed here if occouring modifications take place?      #   - is a "deep_copy" needed here if occouring modifications take place?
198      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
199      #   - 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!
200        #   - so, just use its reference for now - if some cloning is needed in future, do this here!
201      my $source_node = $source_node_real;      my $source_node = $source_node_real;
202    
203      # modify entry - handle new style callbacks (the readers)      # modify entry - handle new style callbacks (the readers)
# Line 199  sub _run { Line 210  sub _run {
210      my $map_callbacks = {};      my $map_callbacks = {};
211      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
212    
213          # trace
214            #print Dumper($callbacks);
215            #exit;
216    
217        my $error = 0;        my $error = 0;
218    
219        foreach my $node (keys %{$callbacks->{read}}) {        foreach my $node (keys %{$callbacks->{read}}) {
# Line 206  sub _run { Line 221  sub _run {
221          my $object = $source_node;          my $object = $source_node;
222          my $value; # = $source_node->{$node};          my $value; # = $source_node->{$node};
223    
224    #print Dumper($self->{options});
225    
226          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
227          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
228          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
# Line 213  sub _run { Line 230  sub _run {
230          #print $evalstring, "\n"; exit;          #print $evalstring, "\n"; exit;
231          my $cb_result = eval($evalstring);          my $cb_result = eval($evalstring);
232          if ($@) {          if ($@) {
233            die $@;            #die $@;
234              $logger->error( __PACKAGE__ . "->_run: $@" );
235            $error = 1;            $error = 1;
236            print $@, "\n";            #print $@, "\n";
237              return;
238          }          }
239          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
240                    
# Line 225  sub _run { Line 244  sub _run {
244    
245      }      }
246    
247  #print Dumper($source_node);      # trace
248          #print Dumper($source_node);
249    
250      # exclude defined fields  (simply delete from object)      # exclude defined fields  (simply delete from object)
251      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
# Line 234  sub _run { Line 254  sub _run {
254      $self->{node} = {};      $self->{node} = {};
255      $self->{node}->{source}->{payload} = $source_node;      $self->{node}->{source}->{payload} = $source_node;
256    
257  #print "res - ident", "\n";      # trace
258          #print Dumper($self->{node});
259          #exit;
260    
261      # determine ident of entry      # determine ident of entry
262      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
# Line 256  sub _run { Line 278  sub _run {
278    
279  #print "checksum", "\n";  #print "checksum", "\n";
280            
     print ":" if $self->{verbose};  
   
281      #print Dumper($self);      #print Dumper($self);
282            
283      # determine status of entry by synchronization method      # determine status of entry by synchronization method
# Line 290  sub _run { Line 310  sub _run {
310        # determine if entry is "new" or "dirty"        # determine if entry is "new" or "dirty"
311        # after all, this seems to be the point where the hammer falls.....        # after all, this seems to be the point where the hammer falls.....
312        print "c" if $self->{verbose};        print "c" if $self->{verbose};
313  #print Dumper($self->{node});  
314  #exit;        # trace
315            #print Dumper($self->{node});
316            #exit;
317    
318        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
319        if (!$self->{node}->{status}->{new}) {        if (!$self->{node}->{status}->{new}) {
320          $self->{node}->{status}->{dirty} =          $self->{node}->{status}->{dirty} =
# Line 319  sub _run { Line 342  sub _run {
342      $self->buildAttributeMap();      $self->buildAttributeMap();
343    
344    
345  #print Dumper($self->{node}); exit;      # trace
346          #print Dumper($self->{node}); exit;
347  #print "attempt", "\n";        #print "attempt", "\n";
348    
349      # additional (new) checks for feature "write-protection"      # additional (new) checks for feature "write-protection"
350      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
# Line 334  sub _run { Line 357  sub _run {
357        next;        next;
358      }      }
359    
360  #print Dumper($self);      # trace
361  #exit;        #print Dumper($self);
362          #exit;
363    
364      # transfer contents of map to target      # transfer contents of map to target
365      if ($self->{node}->{status}->{new}) {      if ($self->{node}->{status}->{new}) {
# Line 371  sub _run { Line 395  sub _run {
395            
396      # 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
397      # 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
398      if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {      #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
399        if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
400        print "r" if $self->{verbose};        print "r" if $self->{verbose};
401        #print Dumper($self->{meta});        #print Dumper($self->{meta});
402        #print Dumper($self->{node});        #print Dumper($self->{node});
# Line 449  sub _dumpCompact { Line 474  sub _dumpCompact {
474  sub _doTransferToTarget {  sub _doTransferToTarget {
475    my $self = shift;    my $self = shift;
476    my $action = shift;    my $action = shift;
477    #print Dumper($self->{node});      
478    #exit;    # trace
479        #print Dumper($self->{meta});
480        #print Dumper($self->{node});
481        #exit;
482        
483    $self->_modifyNode('target', $action, $self->{node}->{map});    $self->_modifyNode('target', $action, $self->{node}->{map});
484  }  }
485    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed