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

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

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

revision 1.1 by joko, Fri Nov 29 04:45:50 2002 UTC revision 1.6 by jonen, Fri Dec 6 04:49:10 2002 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.6  2002/12/06 04:49:10  jonen
10    ##    + disabled output-puffer here
11    ##
12    ##    Revision 1.5  2002/12/05 08:06:05  joko
13    ##    + bugfix with determining empty fields (Null) with DBD::CSV
14    ##    + debugging
15    ##    + updated comments
16    ##
17    ##    Revision 1.4  2002/12/03 15:54:07  joko
18    ##    + {import}-flag is now {prepare}-flag
19    ##
20    ##    Revision 1.3  2002/12/01 22:26:59  joko
21    ##    + minor cosmetics for logging
22    ##
23    ##    Revision 1.2  2002/12/01 04:43:25  joko
24    ##    + mapping deatil entries may now be either an ARRAY or a HASH
25    ##    + erase flag is used now (for export-operations)
26    ##    + expressions to refer to values inside deep nested structures
27    ##    - removed old mappingV2-code
28    ##    + cosmetics
29    ##    + sub _erase_all
30    ##
31  ##    Revision 1.1  2002/11/29 04:45:50  joko  ##    Revision 1.1  2002/11/29 04:45:50  joko
32  ##    + initial check in  ##    + initial check in
33  ##  ##
# Line 23  use Data::Dumper; Line 45  use Data::Dumper;
45  use misc::HashExt;  use misc::HashExt;
46  use libp qw( md5_base64 );  use libp qw( md5_base64 );
47  use libdb qw( quotesql hash2Sql );  use libdb qw( quotesql hash2Sql );
48  use Data::Transform::OO qw( hash2object );  use Data::Transform::Deep qw( hash2object refexpr2perlref );
49  use Data::Compare::Struct qw( getDifference isEmpty );  use Data::Compare::Struct qw( getDifference isEmpty );
50    
51  # get logger instance  # get logger instance
52  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
53    
54    $| = 1;
55    
56  sub new {  sub new {
57    my $invocant = shift;    my $invocant = shift;
# Line 147  sub syncNodes { Line 170  sub syncNodes {
170    $logger->info( __PACKAGE__ . "->syncNodes: source=$self->{meta}->{source}->{dbkey}/$self->{meta}->{source}->{node} $direction_arrow target=$self->{meta}->{target}->{dbkey}/$self->{meta}->{target}->{node}" );    $logger->info( __PACKAGE__ . "->syncNodes: source=$self->{meta}->{source}->{dbkey}/$self->{meta}->{source}->{node} $direction_arrow target=$self->{meta}->{target}->{dbkey}/$self->{meta}->{target}->{node}" );
171    
172    # build mapping    # build mapping
173      # incoming: and Array of node map entries (Array or Hash) - e.g.
174      #   [ 'source:item_name' => 'target:class_val' ]
175      #   { source => 'event->startDateTime', target => 'begindate' }
176    foreach (@{$self->{args}->{mapping}}) {    foreach (@{$self->{args}->{mapping}}) {
177      my @key1 = split(':', $_->[0]);      if (ref $_ eq 'ARRAY') {
178      my @key2 = split(':', $_->[1]);        my @entry1 = split(':', $_->[0]);
179      push @{$self->{meta}->{$key1[0]}->{childnodes}}, $key1[1];        my @entry2 = split(':', $_->[1]);
180      push @{$self->{meta}->{$key2[0]}->{childnodes}}, $key2[1];        my $descent = [];
181          my $node = [];
182          $descent->[0] = $entry1[0];
183          $descent->[1] = $entry2[0];
184          $node->[0] = $entry1[1];
185          $node->[1] = $entry2[1];
186          push @{$self->{meta}->{$descent->[0]}->{childnodes}}, $node->[0];
187          push @{$self->{meta}->{$descent->[1]}->{childnodes}}, $node->[1];
188        } elsif (ref $_ eq 'HASH') {
189          foreach my $entry_key (keys %$_) {
190            my $entry_val = $_->{$entry_key};
191            push @{$self->{meta}->{$entry_key}->{childnodes}}, $entry_val;
192          }
193        }
194    
195    }    }
196    
197    # check partners/nodes: does partner exist / is node available?    # check partners/nodes: does partner exist / is node available?
# Line 185  sub syncNodes { Line 225  sub syncNodes {
225    
226    # import flag means: prepare the source node to be syncable    # import flag means: prepare the source node to be syncable
227    # this is useful if there are e.g. no "ident" or "checksum" columns yet inside a DBI like (row-based) storage    # this is useful if there are e.g. no "ident" or "checksum" columns yet inside a DBI like (row-based) storage
228    if ($self->{args}->{import}) {    if ($self->{args}->{prepare}) {
229      $self->_prepareNode_MetaProperties('source');      $self->_prepareNode_MetaProperties('source');
230      $self->_prepareNode_DummyIdent('source');      $self->_prepareNode_DummyIdent('source');
231      #return;      #return;
232      #$self->_erase_all($opts->{source_node});      #$self->_erase_all($opts->{source_node});
233    }    }
234        
235      # erase flag means: erase the target
236      #if ($opts->{erase}) {
237      if ($self->{args}->{erase}) {
238        # TODO: move this method to the scope of the synchronization core and wrap it around different handlers
239        #print "ERASE", "\n";
240        $self->_erase_all('target');
241      }
242    
243    $self->_syncNodes();    $self->_syncNodes();
244    
245  }  }
# Line 216  sub _syncNodes { Line 264  sub _syncNodes {
264      $results ||= $self->_getNodeList('source', $filter);      $results ||= $self->_getNodeList('source', $filter);
265    }    }
266        
267    # get reference to node list from convenient method provided by corehandle    # get reference to node list from convenient method provided by CORE-HANDLE
268    #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});    #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});
269    #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});    #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});
270    $results ||= $self->_getNodeList('source');    $results ||= $self->_getNodeList('source');
# Line 294  sub _syncNodes { Line 342  sub _syncNodes {
342      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
343      #if (!$identOK && lc $self->{args}->{direction} ne 'import') {      #if (!$identOK && lc $self->{args}->{direction} ne 'import') {
344      if (!$identOK) {      if (!$identOK) {
345        $logger->critical( __PACKAGE__ . "->syncNodes: Can not synchronize: No ident found in source node, maybe try to \"import\" this node first." );        #print Dumper($self->{meta}->{source});
346          $logger->critical( __PACKAGE__ . "->syncNodes: No ident found in source node \"$self->{meta}->{source}->{node}\", try to \"prepare\" this node first?" );
347        return;        return;
348      }      }
349    
350  #print "statload", "\n";  #print "statload", "\n";
351  #print "ident: ", $self->{node}->{source}->{ident}, "\n";  #print "ident: ", $self->{node}->{source}->{ident}, "\n";
352    #print Dumper($self->{node});
353            
354      my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});      my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});
355    
356    #print Dumper($self->{node});
357            
358      # mark node as new either if there's no ident or if stat/load failed      # mark node as new either if there's no ident or if stat/load failed
359      if (!$statOK) {      if (!$statOK) {
# Line 388  sub _syncNodes { Line 440  sub _syncNodes {
440        $tc->{attempt_new}++;        $tc->{attempt_new}++;
441        $self->_doTransferToTarget('insert');        $self->_doTransferToTarget('insert');
442        # asymmetry: refetch node from target to re-calculate new ident and checksum (TODO: is IdentAuthority of relevance here?)        # asymmetry: refetch node from target to re-calculate new ident and checksum (TODO: is IdentAuthority of relevance here?)
443          #print Dumper($self->{node});
444        $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);        $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);
445        $self->_readChecksum('target');        $self->_readChecksum('target');
446    
# Line 413  sub _syncNodes { Line 466  sub _syncNodes {
466      # 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
467      # 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
468      if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {      if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {
469          print "r" if $self->{verbose};
470        #print Dumper($self->{meta});        #print Dumper($self->{meta});
471        #print Dumper($self->{node});        #print Dumper($self->{node});
472        #exit;        #exit;
473        $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});        $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});
       print "r" if $self->{verbose};  
474      }      }
475    
476      print ":" if $self->{verbose};      print ":" if $self->{verbose};
# Line 427  sub _syncNodes { Line 480  sub _syncNodes {
480    print "\n" if $self->{verbose};    print "\n" if $self->{verbose};
481        
482    # build user-message from some stats    # build user-message from some stats
483      my $msg = "stats: $tc";      my $msg = "statistics: $tc";
484            
485      if ($tc->{error_per_row}) {      if ($tc->{error_per_row}) {
486        $msg .= "\n";        $msg .= "\n";
487        $msg .= "errors:" . "\n";        $msg .= "errors from \"error_per_row\":" . "\n";
488        $msg .= Dumper($tc->{error_per_row});        $msg .= Dumper($tc->{error_per_row});
489      }      }
490            
# Line 455  sub _dumpCompact { Line 508  sub _dumpCompact {
508      my $item = {};      my $item = {};
509      foreach my $key (keys %$_) {      foreach my $key (keys %$_) {
510        my $val = $_->{$key};        my $val = $_->{$key};
511    
512    #print Dumper($val);
513    
514        if (ref $val eq 'Set::Object') {        if (ref $val eq 'Set::Object') {
515          #print "========================= SET", "\n";          #print "========================= SET", "\n";
516          #print Dumper($val);  #print Dumper($val);
517          #print Dumper($val->members());          #print Dumper($val->members());
518          #$val = $val->members();          #$val = $val->members();
519          #$vars->[$count]->{$key} = $val->members() if $val->can("members");          #$vars->[$count]->{$key} = $val->members() if $val->can("members");
520          #$item->{$key} = $val->members() if $val->can("members");          #$item->{$key} = $val->members() if $val->can("members");
521          $item->{$key} = $val->members();          $item->{$key} = $val->members();
522          #print Dumper($vars->[$count]->{$key});          #print Dumper($vars->[$count]->{$key});
523    
524        } else {        } else {
525          $item->{$key} = $val;          $item->{$key} = $val;
526        }        }
527    
528      }      }
529      push @data, $item;      push @data, $item;
530      $count++;      $count++;
531    }    }
532    
533  #print "Dump:", "\n";  #print "Dump:", Dumper(@data), "\n";
 #print Dumper(@data);  
534    
535    $Data::Dumper::Indent = 0;    $Data::Dumper::Indent = 0;
536    my $result = Dumper(@data);    my $result = Dumper(@data);
537    $Data::Dumper::Indent = 2;    $Data::Dumper::Indent = 2;
538    return $result;    return $result;
539      
540  }  }
541    
542    
# Line 572  sub _buildMap { Line 630  sub _buildMap {
630        for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {        for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
631          #my $map_right = $self->{args}->{mapping}->{$key};          #my $map_right = $self->{args}->{mapping}->{$key};
632                    
633            $self->{node}->{source}->{propcache} = {};
634            $self->{node}->{target}->{propcache} = {};
635            
636          # get property name          # get property name
637          $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];          $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
638          $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];          $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];
# Line 589  sub _buildMap { Line 650  sub _buildMap {
650            $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};            $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};
651          }          }
652          #$self->{node}->{map}->{$key} = $value;          #$self->{node}->{map}->{$key} = $value;
653            
654            # detect expression
655            # for transferring deeply nested structures described by expressions
656            #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
657            if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
658              
659              # create an anonymous sub to act as callback target dispatcher
660                my $cb_dispatcher = sub {
661                  #print "===============  CALLBACK DISPATCHER", "\n";
662                  #print "ident: ", $self->{node}->{source}->{ident}, "\n";
663                  #return $self->{node}->{source}->{ident};
664                  
665                };
666              
667    
668    #print Dumper($self->{node});
669              
670              # build callback map for helper function
671              #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
672              my $cbmap = {};
673              my $value = refexpr2perlref($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
674              $self->{node}->{source}->{propcache}->{value} = $value;
675            }
676    
677          # encode values dependent on type of underlying storage here - expand cases...          # encode values dependent on type of underlying storage here - expand cases...
678          my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};          my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
679          if ($storage_type eq 'DBI') {          if ($storage_type eq 'DBI') {
680            # ...for sql            # ...for sql
681            $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});            $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
682          } elsif ($storage_type eq 'Tangram') {          }
683             elsif ($storage_type eq 'Tangram') {
684              # iso? utf8 already possible?
685            
686          } elsif ($storage_type eq 'LDAP') {          } elsif ($storage_type eq 'LDAP') {
687            # TODO: encode utf8 here?            # TODO: encode utf8 here?
688          }          }
# Line 606  sub _buildMap { Line 693  sub _buildMap {
693        }        }
694      }      }
695    
 #print "self->{entry}: ", Dumper($self->{node}), "\n"; exit;  
   
     # for transferring deeply nested structures described by expressions  
     # this currently does not work!  
     # TODO: re-enable this!  
     if ($self->{args}->{mappingV2}) {  
         
       # apply mapping from $self->{args}->{mappingV2} to $self->{node}->{map}  
       foreach my $mapStep (@{$self->{args}->{mappingV2}}) {  
           
         # prepare left/right keys/values  
         my $left_key = $mapStep->{left};  
         my $left_val = _resolveMapStepExpr( $self->{node}->{source}->{payload}, $mapStep->{left} );  
         my $right_key = $mapStep->{right};  
         my $right_val = ( $mapStep->{right} );  
         #print "map: $map_right", "\n";  
           
         if ($mapStep->{method}) {  
           if ($mapStep->{method} eq 'v:1') {  
             $left_val = $left_key;  
           }  
         }  
   
         #$self->{node}->{map}->{$key} = $value;  
         #if ( grep(!/$right_key/, @{$self->{args}->{exclude}}) ) {  
           $self->{node}->{map}->{$right_key} = $self->{R}->quoteSql($left_val);  
         #}  
       }  
     }  
696            
697    # TODO: $logger->dump( ... );    # TODO: $logger->dump( ... );
698    #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );    #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
# Line 708  sub _modifyNode { Line 766  sub _modifyNode {
766      }      }
767    }    }
768        
769      
770      #print Dumper($self->{meta});
771    
772    # DBI speaks SQL    # DBI speaks SQL
773    if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {    if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {
# Line 809  sub _modifyNode { Line 869  sub _modifyNode {
869        hash2object($object, $map);        hash2object($object, $map);
870    
871        # ... and re-update@orm.        # ... and re-update@orm.
872    #print Dumper($object);
873        $self->{meta}->{$descent}->{storage}->update($object);        $self->{meta}->{$descent}->{storage}->update($object);
874    
875        # asymmetry: get ident after insert        # asymmetry: get ident after insert
876        # TODO:        # TODO:
877        #   - just do this if it is an IdentAuthority        #   - just do this if it is an IdentAuthority
878        #   - use IdentProvider metadata here        #   - use IdentProvider metadata here
879        $self->{node}->{$descent}->{ident} = $self->{meta}->{$descent}->{storage}->id($object);  #print Dumper($self->{meta}->{$descent});
880          my $oid = $self->{meta}->{$descent}->{storage}->id($object);
881    #print "oid: $oid", "\n";
882          $self->{node}->{$descent}->{ident} = $oid;
883    
884    
885      } elsif (lc $action eq 'update') {      } elsif (lc $action eq 'update') {
# Line 912  sub _statloadNode { Line 976  sub _statloadNode {
976        #print "\n", "Attempt to fetch entry implicitely by ident failed: no ident given! This may result in an insert if no write-protection is in the way.", "\n";        #print "\n", "Attempt to fetch entry implicitely by ident failed: no ident given! This may result in an insert if no write-protection is in the way.", "\n";
977        return;        return;
978      }      }
979        
980        # patch for DBD::CSV
981        if ($ident && $ident eq 'Null') {
982          return;
983        }
984    
985      my $result = $self->{meta}->{$descent}->{storage}->sendQuery({      my $result = $self->{meta}->{$descent}->{storage}->sendQuery({
986        node => $self->{meta}->{$descent}->{node},        node => $self->{meta}->{$descent}->{node},
# Line 926  sub _statloadNode { Line 995  sub _statloadNode {
995      my $entry = $result->getNextEntry();      my $entry = $result->getNextEntry();
996      my $status = $result->getStatus();      my $status = $result->getStatus();
997    
998    #print Dumper($status);
999        
1000      # TODO: enhance error handling (store inside tc)      # TODO: enhance error handling (store inside tc)
1001      #if (!$row) {      #if (!$row) {
1002      #  print "\n", "row error", "\n";      #  print "\n", "row error", "\n";
1003      #  next;      #  next;
1004      #}      #}
1005      if (($status && $status->{err}) || !$entry) {  
1006        #$logger->critical( __PACKAGE__ . "->_loadNode (ident=\"$ident\") failed" );      # these checks run before actually loading payload- and meta-data to node-container
1007        return;      
1008      }        # 1st level - hard error
1009          if ($status && $status->{err}) {
1010            $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - hard error (that's ok)" );
1011            return;
1012          }
1013      
1014          # 2nd level - logical (empty/notfound) error
1015          if (($status && $status->{empty}) || !$entry) {
1016            $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - logical error (that's ok)" );
1017            #print "no entry (logical)", "\n";
1018            return;
1019          }
1020    
1021    #print Dumper($entry);
1022    
1023      # was:      # was:
1024      # $self->{node}->{$descent}->{ident} = $ident;        # $self->{node}->{$descent}->{ident} = $ident;  
1025      # is:      # is:
1026      # TODO: re-resolve ident from entry via metadata "IdentProvider"      # TODO: re-resolve ident from entry via metadata "IdentProvider" here - like elsewhere
1027      $self->{node}->{$descent}->{ident} = $ident;      $self->{node}->{$descent}->{ident} = $ident;
1028      $self->{node}->{$descent}->{payload} = $entry;      $self->{node}->{$descent}->{payload} = $entry;
1029    
1030    }    }
1031        
1032    return 1;    return 1;
# Line 964  sub _doModifySource_IdentChecksum { Line 1050  sub _doModifySource_IdentChecksum {
1050      $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,      $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,
1051      cs => $self->{node}->{target}->{checksum},      cs => $self->{node}->{target}->{checksum},
1052    };    };
1053    #print Dumper($map);  
1054    #print Dumper($self->{node});  #print Dumper($map);
1055    #exit;  #print Dumper($self->{node});
1056    #exit;
1057    
1058    $self->_modifyNode('source', 'update', $map);    $self->_modifyNode('source', 'update', $map);
1059  }  }
1060    
# Line 1048  sub _prepareNode_DummyIdent { Line 1136  sub _prepareNode_DummyIdent {
1136      }      }
1137      my $crit = join ' AND ', @crits;      my $crit = join ' AND ', @crits;
1138      print "p" if $self->{verbose};      print "p" if $self->{verbose};
1139    
1140    #print Dumper($map);
1141    #print Dumper($crit);
1142    
1143      $self->_modifyNode($descent, 'update', $map, $crit);      $self->_modifyNode($descent, 'update', $map, $crit);
1144      $i++;      $i++;
1145    }    }
# Line 1063  sub _prepareNode_DummyIdent { Line 1155  sub _prepareNode_DummyIdent {
1155  # TODO: handle this in an abstract way (wipe out use of 'source' and/or 'target' inside core)  # TODO: handle this in an abstract way (wipe out use of 'source' and/or 'target' inside core)
1156  sub _otherSide {  sub _otherSide {
1157    my $self = shift;    my $self = shift;
1158    my $side = shift;    my $descent = shift;
1159    return 'source' if $side eq 'target';    return 'source' if $descent eq 'target';
1160    return 'target' if $side eq 'source';    return 'target' if $descent eq 'source';
1161    return '';    return '';
1162  }  }
1163    
1164    sub _erase_all {
1165      my $self = shift;
1166      my $descent = shift;
1167      #my $node = shift;
1168      my $node = $self->{meta}->{$descent}->{node};
1169      $self->{meta}->{$descent}->{storage}->eraseAll($node);
1170    }
1171    
1172    
1173  =pod  =pod
1174    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed