/[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.7 by joko, Fri Feb 21 08:01:11 2003 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.7  2003/02/21 08:01:11  joko
10    ##    debugging, logging
11    ##    renamed module
12    ##
13    ##    Revision 1.6  2003/02/14 14:03:49  joko
14    ##    + logging, debugging
15    ##    - refactored code to sister module
16    ##
17    ##    Revision 1.5  2003/02/11 05:30:47  joko
18    ##    + minor fixes and some debugging mud
19    ##
20  ##    Revision 1.4  2003/02/09 05:01:10  joko  ##    Revision 1.4  2003/02/09 05:01:10  joko
21  ##    + major structure changes  ##    + major structure changes
22  ##    - refactored code to sister modules  ##    - refactored code to sister modules
# Line 79  use mixin::with qw( Data::Transfer::Sync Line 90  use mixin::with qw( Data::Transfer::Sync
90    
91  use Data::Dumper;  use Data::Dumper;
92    
93  use misc::HashExt;  #use misc::HashExt;
94    use Hash::Serializer;
95  use Data::Compare::Struct qw( getDifference isEmpty );  use Data::Compare::Struct qw( getDifference isEmpty );
96  use Data::Storage::Container;  use Data::Storage::Container;
97  use DesignPattern::Object;  use DesignPattern::Object;
98    use libdb qw( quotesql );
99    
100  # get logger instance  # get logger instance
101  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 113  sub _init { Line 126  sub _init {
126      $self->{container}->addStorage($_, $self->{storages}->{$_});      $self->{container}->addStorage($_, $self->{storages}->{$_});
127    }    }
128        
129      # trace
130        #print Dumper($self);
131        #exit;
132    
133    return 1;    return 1;
134        
135  }  }
# Line 140  sub _run { Line 157  sub _run {
157    $logger->debug( __PACKAGE__ . "->_run" );    $logger->debug( __PACKAGE__ . "->_run" );
158    
159    # for statistics    # for statistics
160    my $tc = OneLineDumpHash->new( {} );    my $tc = Hash::Serializer->new( {} );
161    my $results;    my $results;
162        
163    # set of objects is already in $self->{args}    # set of objects is already in $self->{args}
# Line 178  sub _run { Line 195  sub _run {
195    # iterate through set    # iterate through set
196    foreach my $source_node_real (@results) {    foreach my $source_node_real (@results) {
197    
198        print ":" if $self->{verbose};
199    
200      $tc->{total}++;      $tc->{total}++;
201    
202  #print "========================  iter", "\n";  #print "========================  iter", "\n";
# Line 187  sub _run { Line 206  sub _run {
206      #   - is a "deep_copy" needed here if occouring modifications take place?      #   - is a "deep_copy" needed here if occouring modifications take place?
207      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?      #   - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
208      #   - 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!
209        #   - so, just use its reference for now - if some cloning is needed in future, do this here!
210      my $source_node = $source_node_real;      my $source_node = $source_node_real;
211    
212      # modify entry - handle new style callbacks (the readers)      # modify entry - handle new style callbacks (the readers)
213  #print Dumper($source_node);  
214  #exit;      # trace
215          #print Dumper($source_node);
216          #exit;
217    
218      my $descent = 'source';      my $descent = 'source';
219    
# Line 199  sub _run { Line 221  sub _run {
221      my $map_callbacks = {};      my $map_callbacks = {};
222      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {      if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
223    
224          # trace
225            #print Dumper($callbacks);
226            #exit;
227    
228        my $error = 0;        my $error = 0;
229    
230        foreach my $node (keys %{$callbacks->{read}}) {        foreach my $node (keys %{$callbacks->{read}}) {
# Line 206  sub _run { Line 232  sub _run {
232          my $object = $source_node;          my $object = $source_node;
233          my $value; # = $source_node->{$node};          my $value; # = $source_node->{$node};
234    
235          # trace
236            #print Dumper($self->{options});
237    
238          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
239          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';          #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
240          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';          my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
# Line 213  sub _run { Line 242  sub _run {
242          #print $evalstring, "\n"; exit;          #print $evalstring, "\n"; exit;
243          my $cb_result = eval($evalstring);          my $cb_result = eval($evalstring);
244          if ($@) {          if ($@) {
           die $@;  
245            $error = 1;            $error = 1;
246            print $@, "\n";            $logger->error( __PACKAGE__ . "->_run: $@" );
247              next;
248          }          }
249          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)          # ------------  half-redundant: make $self->callCallback($object, $value, $opts)
250                    
# Line 225  sub _run { Line 254  sub _run {
254    
255      }      }
256    
257  #print Dumper($source_node);      # trace
258          #print Dumper($source_node);
259    
260      # exclude defined fields  (simply delete from object)      # exclude defined fields  (simply delete from object)
261      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};      map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
# Line 234  sub _run { Line 264  sub _run {
264      $self->{node} = {};      $self->{node} = {};
265      $self->{node}->{source}->{payload} = $source_node;      $self->{node}->{source}->{payload} = $source_node;
266    
267  #print "res - ident", "\n";      # trace
268          #print Dumper($self->{node});
269          #exit;
270    
271      # determine ident of entry      # determine ident of entry
272      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
# Line 256  sub _run { Line 288  sub _run {
288    
289  #print "checksum", "\n";  #print "checksum", "\n";
290            
     print ":" if $self->{verbose};  
   
291      #print Dumper($self);      #print Dumper($self);
292            
293      # determine status of entry by synchronization method      # determine status of entry by synchronization method
# Line 290  sub _run { Line 320  sub _run {
320        # determine if entry is "new" or "dirty"        # determine if entry is "new" or "dirty"
321        # after all, this seems to be the point where the hammer falls.....        # after all, this seems to be the point where the hammer falls.....
322        print "c" if $self->{verbose};        print "c" if $self->{verbose};
323  #print Dumper($self->{node});  
324  #exit;        # trace
325            #print Dumper($self->{node});
326            #exit;
327    
328        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};        $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
329        if (!$self->{node}->{status}->{new}) {        if (!$self->{node}->{status}->{new}) {
330          $self->{node}->{status}->{dirty} =          $self->{node}->{status}->{dirty} =
# Line 319  sub _run { Line 352  sub _run {
352      $self->buildAttributeMap();      $self->buildAttributeMap();
353    
354    
355  #print Dumper($self->{node}); exit;      # trace
356          #print Dumper($self->{node}); exit;
357  #print "attempt", "\n";        #print "attempt", "\n";
358    
359      # additional (new) checks for feature "write-protection"      # additional (new) checks for feature "write-protection"
360      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {      if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
# Line 334  sub _run { Line 367  sub _run {
367        next;        next;
368      }      }
369    
370  #print Dumper($self);      # trace
371  #exit;        #print Dumper($self);
372          #exit;
373    
374      # transfer contents of map to target      # transfer contents of map to target
375      if ($self->{node}->{status}->{new}) {      if ($self->{node}->{status}->{new}) {
# Line 371  sub _run { Line 405  sub _run {
405            
406      # 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
407      # 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
408      if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {      #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
409        if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
410        print "r" if $self->{verbose};        print "r" if $self->{verbose};
411        #print Dumper($self->{meta});        #print Dumper($self->{meta});
412        #print Dumper($self->{node});        #print Dumper($self->{node});
# Line 394  sub _run { Line 429  sub _run {
429            
430      # todo!!!      # todo!!!
431      #sysevent( { usermsg => $msg, level => $level }, $taskEvent );      #sysevent( { usermsg => $msg, level => $level }, $taskEvent );
432      $logger->info( __PACKAGE__ . "->_run: $msg" );      #$logger->info( __PACKAGE__ . "->_run: $msg" );
433        $logger->info($msg . "\n");
434    
435    return $tc;    return $tc;
436    
# Line 449  sub _dumpCompact { Line 485  sub _dumpCompact {
485  sub _doTransferToTarget {  sub _doTransferToTarget {
486    my $self = shift;    my $self = shift;
487    my $action = shift;    my $action = shift;
488    #print Dumper($self->{node});      
489    #exit;    # trace
490        #print Dumper($self->{meta});
491        #print Dumper($self->{node});
492        #exit;
493        
494    $self->_modifyNode('target', $action, $self->{node}->{map});    $self->_modifyNode('target', $action, $self->{node}->{map});
495  }  }
496    
# Line 551  sub _prepareNode_DummyIdent { Line 591  sub _prepareNode_DummyIdent {
591      $i++;      $i++;
592    }    }
593    
594    print "\n" if $self->{verbose};    #print "\n" if $self->{verbose};
595        
596    if (!$i) {    if (!$i) {
597      $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );      $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );
# Line 568  sub _otherSide { Line 608  sub _otherSide {
608    return '';    return '';
609  }  }
610    
 sub _erase_all {  
   my $self = shift;  
   my $descent = shift;  
   #my $node = shift;  
   my $node = $self->{meta}->{$descent}->{node};  
   $self->{meta}->{$descent}->{storage}->eraseAll($node);  
 }  
611    
612  1;  1;
613    __END__
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed