/[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.8 by joko, Thu Mar 27 15:31:15 2003 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.8  2003/03/27 15:31:15  joko
10    ##    fixes to modules regarding new namespace(s) below Data::Mungle::*
11    ##
12    ##    Revision 1.7  2003/02/21 08:01:11  joko
13    ##    debugging, logging
14    ##    renamed module
15    ##
16    ##    Revision 1.6  2003/02/14 14:03:49  joko
17    ##    + logging, debugging
18    ##    - refactored code to sister module
19    ##
20    ##    Revision 1.5  2003/02/11 05:30:47  joko
21    ##    + minor fixes and some debugging mud
22    ##
23  ##    Revision 1.4  2003/02/09 05:01:10  joko  ##    Revision 1.4  2003/02/09 05:01:10  joko
24  ##    + major structure changes  ##    + major structure changes
25  ##    - refactored code to sister modules  ##    - refactored code to sister modules
# Line 79  use mixin::with qw( Data::Transfer::Sync Line 93  use mixin::with qw( Data::Transfer::Sync
93    
94  use Data::Dumper;  use Data::Dumper;
95    
96  use misc::HashExt;  #use misc::HashExt;
97  use Data::Compare::Struct qw( getDifference isEmpty );  use Hash::Serializer;
98    use Data::Mungle::Compare::Struct qw( getDifference isEmpty );
99  use Data::Storage::Container;  use Data::Storage::Container;
100  use DesignPattern::Object;  use DesignPattern::Object;
101    use libdb qw( quotesql );
102    
103  # get logger instance  # get logger instance
104  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 113  sub _init { Line 129  sub _init {
129      $self->{container}->addStorage($_, $self->{storages}->{$_});      $self->{container}->addStorage($_, $self->{storages}->{$_});
130    }    }
131        
132      # trace
133        #print Dumper($self);
134        #exit;
135    
136    return 1;    return 1;
137        
138  }  }
# Line 140  sub _run { Line 160  sub _run {
160    $logger->debug( __PACKAGE__ . "->_run" );    $logger->debug( __PACKAGE__ . "->_run" );
161    
162    # for statistics    # for statistics
163    my $tc = OneLineDumpHash->new( {} );    my $tc = Hash::Serializer->new( {} );
164    my $results;    my $results;
165        
166    # set of objects is already in $self->{args}    # set of objects is already in $self->{args}
# Line 178  sub _run { Line 198  sub _run {
198    # iterate through set    # iterate through set
199    foreach my $source_node_real (@results) {    foreach my $source_node_real (@results) {
200    
201        print ":" if $self->{verbose};
202    
203      $tc->{total}++;      $tc->{total}++;
204    
205  #print "========================  iter", "\n";  #print "========================  iter", "\n";
# Line 187  sub _run { Line 209  sub _run {
209      #   - is a "deep_copy" needed here if occouring modifications take place?      #   - is a "deep_copy" needed here if occouring modifications take place?
210      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
211      #   - 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!
212        #   - so, just use its reference for now - if some cloning is needed in future, do this here!
213      my $source_node = $source_node_real;      my $source_node = $source_node_real;
214    
215      # modify entry - handle new style callbacks (the readers)      # modify entry - handle new style callbacks (the readers)
216  #print Dumper($source_node);  
217  #exit;      # trace
218          #print Dumper($source_node);
219          #exit;
220    
221      my $descent = 'source';      my $descent = 'source';
222    
# Line 199  sub _run { Line 224  sub _run {
224      my $map_callbacks = {};      my $map_callbacks = {};
225      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
226    
227          # trace
228            #print Dumper($callbacks);
229            #exit;
230    
231        my $error = 0;        my $error = 0;
232    
233        foreach my $node (keys %{$callbacks->{read}}) {        foreach my $node (keys %{$callbacks->{read}}) {
# Line 206  sub _run { Line 235  sub _run {
235          my $object = $source_node;          my $object = $source_node;
236          my $value; # = $source_node->{$node};          my $value; # = $source_node->{$node};
237    
238          # trace
239            #print Dumper($self->{options});
240    
241          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
242          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
243          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
# Line 213  sub _run { Line 245  sub _run {
245          #print $evalstring, "\n"; exit;          #print $evalstring, "\n"; exit;
246          my $cb_result = eval($evalstring);          my $cb_result = eval($evalstring);
247          if ($@) {          if ($@) {
           die $@;  
248            $error = 1;            $error = 1;
249            print $@, "\n";            $logger->error( __PACKAGE__ . "->_run: $@" );
250              next;
251          }          }
252          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
253                    
# Line 225  sub _run { Line 257  sub _run {
257    
258      }      }
259    
260  #print Dumper($source_node);      # trace
261          #print Dumper($source_node);
262    
263      # exclude defined fields  (simply delete from object)      # exclude defined fields  (simply delete from object)
264      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
# Line 234  sub _run { Line 267  sub _run {
267      $self->{node} = {};      $self->{node} = {};
268      $self->{node}->{source}->{payload} = $source_node;      $self->{node}->{source}->{payload} = $source_node;
269    
270  #print "res - ident", "\n";      # trace
271          #print Dumper($self->{node});
272          #exit;
273    
274      # determine ident of entry      # determine ident of entry
275      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
# Line 256  sub _run { Line 291  sub _run {
291    
292  #print "checksum", "\n";  #print "checksum", "\n";
293            
     print ":" if $self->{verbose};  
   
294      #print Dumper($self);      #print Dumper($self);
295            
296      # determine status of entry by synchronization method      # determine status of entry by synchronization method
# Line 290  sub _run { Line 323  sub _run {
323        # determine if entry is "new" or "dirty"        # determine if entry is "new" or "dirty"
324        # after all, this seems to be the point where the hammer falls.....        # after all, this seems to be the point where the hammer falls.....
325        print "c" if $self->{verbose};        print "c" if $self->{verbose};
326  #print Dumper($self->{node});  
327  #exit;        # trace
328            #print Dumper($self->{node});
329            #exit;
330    
331        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
332        if (!$self->{node}->{status}->{new}) {        if (!$self->{node}->{status}->{new}) {
333          $self->{node}->{status}->{dirty} =          $self->{node}->{status}->{dirty} =
# Line 319  sub _run { Line 355  sub _run {
355      $self->buildAttributeMap();      $self->buildAttributeMap();
356    
357    
358  #print Dumper($self->{node}); exit;      # trace
359          #print Dumper($self->{node}); exit;
360  #print "attempt", "\n";        #print "attempt", "\n";
361    
362      # additional (new) checks for feature "write-protection"      # additional (new) checks for feature "write-protection"
363      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
# Line 334  sub _run { Line 370  sub _run {
370        next;        next;
371      }      }
372    
373  #print Dumper($self);      # trace
374  #exit;        #print Dumper($self);
375          #exit;
376    
377      # transfer contents of map to target      # transfer contents of map to target
378      if ($self->{node}->{status}->{new}) {      if ($self->{node}->{status}->{new}) {
# Line 371  sub _run { Line 408  sub _run {
408            
409      # 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
410      # 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
411      if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {      #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
412        if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
413        print "r" if $self->{verbose};        print "r" if $self->{verbose};
414        #print Dumper($self->{meta});        #print Dumper($self->{meta});
415        #print Dumper($self->{node});        #print Dumper($self->{node});
# Line 394  sub _run { Line 432  sub _run {
432            
433      # todo!!!      # todo!!!
434      #sysevent( { usermsg => $msg, level => $level }, $taskEvent );      #sysevent( { usermsg => $msg, level => $level }, $taskEvent );
435      $logger->info( __PACKAGE__ . "->_run: $msg" );      #$logger->info( __PACKAGE__ . "->_run: $msg" );
436        $logger->info($msg . "\n");
437    
438    return $tc;    return $tc;
439    
# Line 449  sub _dumpCompact { Line 488  sub _dumpCompact {
488  sub _doTransferToTarget {  sub _doTransferToTarget {
489    my $self = shift;    my $self = shift;
490    my $action = shift;    my $action = shift;
491    #print Dumper($self->{node});      
492    #exit;    # trace
493        #print Dumper($self->{meta});
494        #print Dumper($self->{node});
495        #exit;
496        
497    $self->_modifyNode('target', $action, $self->{node}->{map});    $self->_modifyNode('target', $action, $self->{node}->{map});
498  }  }
499    
# Line 551  sub _prepareNode_DummyIdent { Line 594  sub _prepareNode_DummyIdent {
594      $i++;      $i++;
595    }    }
596    
597    print "\n" if $self->{verbose};    #print "\n" if $self->{verbose};
598        
599    if (!$i) {    if (!$i) {
600      $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );      $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );
# Line 568  sub _otherSide { Line 611  sub _otherSide {
611    return '';    return '';
612  }  }
613    
 sub _erase_all {  
   my $self = shift;  
   my $descent = shift;  
   #my $node = shift;  
   my $node = $self->{meta}->{$descent}->{node};  
   $self->{meta}->{$descent}->{storage}->eraseAll($node);  
 }  
614    
615  1;  1;
616    __END__
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed