/[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.8 by joko, Sun Dec 15 02:03:09 2002 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.8  2002/12/15 02:03:09  joko
10    ##    + fixed logging-messages
11    ##    + additional metadata-checks
12    ##
13    ##    Revision 1.7  2002/12/13 21:49:34  joko
14    ##    + sub configure
15    ##    + sub checkOptions
16    ##
17    ##    Revision 1.6  2002/12/06 04:49:10  jonen
18    ##    + disabled output-puffer here
19    ##
20    ##    Revision 1.5  2002/12/05 08:06:05  joko
21    ##    + bugfix with determining empty fields (Null) with DBD::CSV
22    ##    + debugging
23    ##    + updated comments
24    ##
25    ##    Revision 1.4  2002/12/03 15:54:07  joko
26    ##    + {import}-flag is now {prepare}-flag
27    ##
28    ##    Revision 1.3  2002/12/01 22:26:59  joko
29    ##    + minor cosmetics for logging
30    ##
31    ##    Revision 1.2  2002/12/01 04:43:25  joko
32    ##    + mapping deatil entries may now be either an ARRAY or a HASH
33    ##    + erase flag is used now (for export-operations)
34    ##    + expressions to refer to values inside deep nested structures
35    ##    - removed old mappingV2-code
36    ##    + cosmetics
37    ##    + sub _erase_all
38    ##
39  ##    Revision 1.1  2002/11/29 04:45:50  joko  ##    Revision 1.1  2002/11/29 04:45:50  joko
40  ##    + initial check in  ##    + initial check in
41  ##  ##
# Line 20  use strict; Line 50  use strict;
50  use warnings;  use warnings;
51    
52  use Data::Dumper;  use Data::Dumper;
53    #use Hash::Merge qw( merge );
54    
55  use misc::HashExt;  use misc::HashExt;
56  use libp qw( md5_base64 );  use libp qw( md5_base64 );
57  use libdb qw( quotesql hash2Sql );  use libdb qw( quotesql hash2Sql );
58  use Data::Transform::OO qw( hash2object );  use Data::Transform::Deep qw( hash2object refexpr2perlref );
59  use Data::Compare::Struct qw( getDifference isEmpty );  use Data::Compare::Struct qw( getDifference isEmpty );
60    
61  # get logger instance  # get logger instance
62  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
63    
64    $| = 1;
65    
66  sub new {  sub new {
67    my $invocant = shift;    my $invocant = shift;
68    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
69    my $self = { @_ };    my $self = {};
70    $logger->debug( __PACKAGE__ . "->new(@_)" );    $logger->debug( __PACKAGE__ . "->new(@_)" );
71    bless $self, $class;    bless $self, $class;
72    $self->_init();    $self->configure(@_);
73    return $self;    return $self;
74  }  }
75    
76    
77    sub configure {
78      my $self = shift;
79      my @args = @_;
80      if (!isEmpty(\@args)) {
81        my %properties = @_;
82        # merge args to properties
83        map { $self->{$_} = $properties{$_}; } keys %properties;
84        $self->_init();
85      } else {
86        #print "no args!", "\n";
87      }
88      #print Dumper($self);
89    }
90    
91  sub _init {  sub _init {
92    my $self = shift;    my $self = shift;
93    
94      $self->{configured} = 1;
95        
96    # build new container if necessary    # build new container if necessary
97    $self->{container} = Data::Storage::Container->new() if !$self->{container};    $self->{container} = Data::Storage::Container->new() if !$self->{container};
# Line 61  sub _init { Line 110  sub _init {
110  }  }
111    
112    
113    sub prepareOptions {
114    
115      my $self = shift;
116      my $opts = shift;
117    
118    #print Dumper($opts);
119    
120      $opts->{mode} ||= '';
121      $opts->{erase} ||= 0;
122      #$opts->{import} ||= 0;
123      
124      $logger->info( __PACKAGE__ . "->prepareOptions( source_node $opts->{source_node} mode $opts->{mode} erase $opts->{erase} prepare $opts->{prepare} )");
125    
126      if (!$opts->{mapping} || !$opts->{mapping_module}) {
127        $logger->warning( __PACKAGE__ . "->prepareOptions: No mapping supplied - please check key 'mappings' in BizWorks/Config.pm");
128      }
129    
130      my $evstring = "use $opts->{mapping_module};";
131      eval($evstring);
132      if ($@) {
133        $logger->warning( __PACKAGE__ . "->prepareOptions: error while trying to access mapping - $@");
134        return;
135      }
136    
137      # resolve mapping metadata (returned from sub)
138      my $mapObject = $opts->{mapping_module}->new();
139      #print Dumper($map);
140      my $source_node_name = $opts->{source_node};
141      # check if mapping for certain node is contained in mapping object
142      if (!$mapObject->can($source_node_name)) {
143        $logger->warning( __PACKAGE__ . "->prepareOptions: Can't access mapping for node \"$source_node_name\" - please check $opts->{mapping_module}.");
144        return;
145      }
146      my $map = $mapObject->$source_node_name;
147    
148      # remove asymmetries from $map (patch keys)
149      $map->{source_node} = $map->{source}; delete $map->{source};
150      $map->{target_node} = $map->{target}; delete $map->{target};
151      $map->{mapping} = $map->{details}; delete $map->{details};
152      $map->{direction} = $map->{mode}; delete $map->{mode};
153    
154      # defaults (mostly for backward-compatibility)
155      $map->{source_node} ||= $source_node_name;
156      $map->{source_ident} ||= 'storage_method:id';
157      $map->{target_ident} ||= 'property:oid';
158      $map->{direction} ||= $opts->{mode};         # | PUSH | PULL | FULL
159      $map->{method} ||= 'checksum';                # | timestamp
160      $map->{source_exclude} ||= [qw( cs )];
161    
162      # merge map to opts
163      map { $opts->{$_} = $map->{$_}; } keys %$map;
164        
165    #print Dumper($opts);
166    
167      # TODO: move this to checkOptions...
168      
169      # check - do we have a target?
170      if (!$opts->{target_node}) {
171        $logger->warning( __PACKAGE__ . "->prepareOptions: No target given - please check metadata declaration.");
172        return;
173      }
174    
175    
176      #return $opts;
177      return 1;
178    
179    }
180    
181    
182    sub checkOptions {
183      my $self = shift;
184      my $opts = shift;
185      
186      my $result = 1;
187      
188      # check - do we have a target node?
189      if (!$opts->{target_node}) {
190        $logger->warning( __PACKAGE__ . "->checkOptions: Error while resolving resource metadata - no 'target node' could be determined.");
191        $result = 0;
192      }
193    
194      # check - do we have a mapping?
195      if (!$opts->{mapping} && !$opts->{mapping_module}) {
196        $logger->warning( __PACKAGE__ . "->checkOptions: Error while resolving resource metadata - no 'mapping' could be determined.");
197        $result = 0;
198      }
199      
200      return $result;
201      
202    }
203    
204    
205  # TODO: some feature to show off the progress of synchronization (cur/max * 100)  # TODO: some feature to show off the progress of synchronization (cur/max * 100)
206  sub syncNodes {  sub syncNodes {
207    
208    my $self = shift;    my $self = shift;
209    my $args = shift;    my $args = shift;
210    
211      if (!$self->{configured}) {
212        $logger->critical( __PACKAGE__ . "->syncNodes: Synchronization object is not configured/initialized correctly." );
213        return;
214      }
215    
216    # remember arguments through the whole processing    # remember arguments through the whole processing
217    $self->{args} = $args;    $self->{args} = $args;
218    
# Line 89  sub syncNodes { Line 235  sub syncNodes {
235    }    }
236    
237    # decompose identifiers for each partner    # decompose identifiers for each partner
238    # TODO: take this list from already established/given metadata    # TODO: refactor!!! take this list from already established/given metadata
239    foreach ('source', 'target') {    foreach ('source', 'target') {
240            
241      # get/set metadata for further processing      # get/set metadata for further processing
# Line 144  sub syncNodes { Line 290  sub syncNodes {
290      #print "iiiiisprov: ", Dumper($self->{meta}->{$_}->{storage}), "\n";      #print "iiiiisprov: ", Dumper($self->{meta}->{$_}->{storage}), "\n";
291    }    }
292    
293    #print Dumper($self->{meta});
294    
295    $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}" );
296    
297    # build mapping    # build mapping
298      # incoming: and Array of node map entries (Array or Hash) - e.g.
299      #   [ 'source:item_name' => 'target:class_val' ]
300      #   { source => 'event->startDateTime', target => 'begindate' }
301    foreach (@{$self->{args}->{mapping}}) {    foreach (@{$self->{args}->{mapping}}) {
302      my @key1 = split(':', $_->[0]);      if (ref $_ eq 'ARRAY') {
303      my @key2 = split(':', $_->[1]);        my @entry1 = split(':', $_->[0]);
304      push @{$self->{meta}->{$key1[0]}->{childnodes}}, $key1[1];        my @entry2 = split(':', $_->[1]);
305      push @{$self->{meta}->{$key2[0]}->{childnodes}}, $key2[1];        my $descent = [];
306          my $node = [];
307          $descent->[0] = $entry1[0];
308          $descent->[1] = $entry2[0];
309          $node->[0] = $entry1[1];
310          $node->[1] = $entry2[1];
311          push @{$self->{meta}->{$descent->[0]}->{childnodes}}, $node->[0];
312          push @{$self->{meta}->{$descent->[1]}->{childnodes}}, $node->[1];
313        } elsif (ref $_ eq 'HASH') {
314          foreach my $entry_key (keys %$_) {
315            my $entry_val = $_->{$entry_key};
316            push @{$self->{meta}->{$entry_key}->{childnodes}}, $entry_val;
317          }
318        }
319    
320    }    }
321    
322    #print Dumper($self->{meta});
323      
324    # check partners/nodes: does partner exist / is node available?    # check partners/nodes: does partner exist / is node available?
325    foreach my $partner (keys %{$self->{meta}}) {    foreach my $partner (keys %{$self->{meta}}) {
326      next if $self->{meta}->{$partner}->{storage}->{locator}->{type} eq 'DBI';    # for DBD::CSV - re-enable for others      
327        # 1. check partners & storages
328        if (!$self->{meta}->{$partner}) {
329          $logger->critical( __PACKAGE__ . "->syncNodes: Could not find partner '$partner' in configuration metadata." );
330          return;
331        }
332    
333        my $dbkey = $self->{meta}->{$partner}->{dbkey};
334    
335        if (!$self->{meta}->{$partner}->{storage}) {
336          $logger->critical( __PACKAGE__ . "->syncNodes: Could not access storage of partner '$partner' (named '$dbkey'), looks like a configuration-error." );
337          return;
338        }
339        
340        # TODO:
341        # 2. check if partners (and nodes?) are actually available....
342        # eventually pre-check mode of access-attempt (read/write) here to provide an "early-croak" if possible
343        
344        # 3. check nodes
345        next if $self->{meta}->{$partner}->{storage}->{locator}->{type} eq 'DBI';    # HACK for DBD::CSV - re-enable for others
346        # get node-name
347      my $node = $self->{meta}->{$partner}->{node};      my $node = $self->{meta}->{$partner}->{node};
348      if (!$self->{meta}->{$partner}->{storage}->existsChildNode($node)) {      if (!$self->{meta}->{$partner}->{storage}->existsChildNode($node)) {
349        $logger->critical( __PACKAGE__ . "->syncNodes: Could not reach \"$node\" at \"$partner\"." );        $logger->critical( __PACKAGE__ . "->syncNodes: Could not reach node \"$node\" at partner \"$partner\"." );
350        return;        return;
351      }      }
352        
353    }    }
354    
355    # TODO:    # TODO:
# Line 185  sub syncNodes { Line 373  sub syncNodes {
373    
374    # import flag means: prepare the source node to be syncable    # import flag means: prepare the source node to be syncable
375    # 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
376    if ($self->{args}->{import}) {    if ($self->{args}->{prepare}) {
377      $self->_prepareNode_MetaProperties('source');      $self->_prepareNode_MetaProperties('source');
378      $self->_prepareNode_DummyIdent('source');      $self->_prepareNode_DummyIdent('source');
379      #return;      #return;
380      #$self->_erase_all($opts->{source_node});      #$self->_erase_all($opts->{source_node});
381    }    }
382        
383      # erase flag means: erase the target
384      #if ($opts->{erase}) {
385      if ($self->{args}->{erase}) {
386        # TODO: move this method to the scope of the synchronization core and wrap it around different handlers
387        #print "ERASE", "\n";
388        $self->_erase_all('target');
389      }
390    
391    $self->_syncNodes();    $self->_syncNodes();
392    
393  }  }
# Line 216  sub _syncNodes { Line 412  sub _syncNodes {
412      $results ||= $self->_getNodeList('source', $filter);      $results ||= $self->_getNodeList('source', $filter);
413    }    }
414        
415    # get reference to node list from convenient method provided by corehandle    # get reference to node list from convenient method provided by CORE-HANDLE
416    #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});    #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});
417    #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});    #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});
418    $results ||= $self->_getNodeList('source');    $results ||= $self->_getNodeList('source');
# Line 294  sub _syncNodes { Line 490  sub _syncNodes {
490      my $identOK = $self->_resolveNodeIdent('source');      my $identOK = $self->_resolveNodeIdent('source');
491      #if (!$identOK && lc $self->{args}->{direction} ne 'import') {      #if (!$identOK && lc $self->{args}->{direction} ne 'import') {
492      if (!$identOK) {      if (!$identOK) {
493        $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});
494          $logger->critical( __PACKAGE__ . "->syncNodes: No ident found in source node \"$self->{meta}->{source}->{node}\", try to \"prepare\" this node first?" );
495        return;        return;
496      }      }
497    
498  #print "statload", "\n";  #print "statload", "\n";
499  #print "ident: ", $self->{node}->{source}->{ident}, "\n";  #print "ident: ", $self->{node}->{source}->{ident}, "\n";
500    #print Dumper($self->{node});
501            
502      my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});      my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});
503    
504    #print Dumper($self->{node});
505            
506      # 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
507      if (!$statOK) {      if (!$statOK) {
# Line 388  sub _syncNodes { Line 588  sub _syncNodes {
588        $tc->{attempt_new}++;        $tc->{attempt_new}++;
589        $self->_doTransferToTarget('insert');        $self->_doTransferToTarget('insert');
590        # 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?)
591          #print Dumper($self->{node});
592        $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);        $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);
593        $self->_readChecksum('target');        $self->_readChecksum('target');
594    
# Line 413  sub _syncNodes { Line 614  sub _syncNodes {
614      # 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
615      # 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
616      if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {      if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {
617          print "r" if $self->{verbose};
618        #print Dumper($self->{meta});        #print Dumper($self->{meta});
619        #print Dumper($self->{node});        #print Dumper($self->{node});
620        #exit;        #exit;
621        $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});        $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});
       print "r" if $self->{verbose};  
622      }      }
623    
624      print ":" if $self->{verbose};      print ":" if $self->{verbose};
# Line 427  sub _syncNodes { Line 628  sub _syncNodes {
628    print "\n" if $self->{verbose};    print "\n" if $self->{verbose};
629        
630    # build user-message from some stats    # build user-message from some stats
631      my $msg = "stats: $tc";      my $msg = "statistics: $tc";
632            
633      if ($tc->{error_per_row}) {      if ($tc->{error_per_row}) {
634        $msg .= "\n";        $msg .= "\n";
635        $msg .= "errors:" . "\n";        $msg .= "errors from \"error_per_row\":" . "\n";
636        $msg .= Dumper($tc->{error_per_row});        $msg .= Dumper($tc->{error_per_row});
637      }      }
638            
# Line 455  sub _dumpCompact { Line 656  sub _dumpCompact {
656      my $item = {};      my $item = {};
657      foreach my $key (keys %$_) {      foreach my $key (keys %$_) {
658        my $val = $_->{$key};        my $val = $_->{$key};
659    
660    #print Dumper($val);
661    
662        if (ref $val eq 'Set::Object') {        if (ref $val eq 'Set::Object') {
663          #print "========================= SET", "\n";          #print "========================= SET", "\n";
664          #print Dumper($val);  #print Dumper($val);
665          #print Dumper($val->members());          #print Dumper($val->members());
666          #$val = $val->members();          #$val = $val->members();
667          #$vars->[$count]->{$key} = $val->members() if $val->can("members");          #$vars->[$count]->{$key} = $val->members() if $val->can("members");
668          #$item->{$key} = $val->members() if $val->can("members");          #$item->{$key} = $val->members() if $val->can("members");
669          $item->{$key} = $val->members();          $item->{$key} = $val->members();
670          #print Dumper($vars->[$count]->{$key});          #print Dumper($vars->[$count]->{$key});
671    
672        } else {        } else {
673          $item->{$key} = $val;          $item->{$key} = $val;
674        }        }
675    
676      }      }
677      push @data, $item;      push @data, $item;
678      $count++;      $count++;
679    }    }
680    
681  #print "Dump:", "\n";  #print "Dump:", Dumper(@data), "\n";
 #print Dumper(@data);  
682    
683    $Data::Dumper::Indent = 0;    $Data::Dumper::Indent = 0;
684    my $result = Dumper(@data);    my $result = Dumper(@data);
685    $Data::Dumper::Indent = 2;    $Data::Dumper::Indent = 2;
686    return $result;    return $result;
687      
688  }  }
689    
690    
# Line 572  sub _buildMap { Line 778  sub _buildMap {
778        for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {        for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
779          #my $map_right = $self->{args}->{mapping}->{$key};          #my $map_right = $self->{args}->{mapping}->{$key};
780                    
781            $self->{node}->{source}->{propcache} = {};
782            $self->{node}->{target}->{propcache} = {};
783            
784          # get property name          # get property name
785          $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];          $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
786          $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 798  sub _buildMap {
798            $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}};
799          }          }
800          #$self->{node}->{map}->{$key} = $value;          #$self->{node}->{map}->{$key} = $value;
801            
802            # detect expression
803            # for transferring deeply nested structures described by expressions
804            #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
805            if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
806              
807              # create an anonymous sub to act as callback target dispatcher
808                my $cb_dispatcher = sub {
809                  #print "===============  CALLBACK DISPATCHER", "\n";
810                  #print "ident: ", $self->{node}->{source}->{ident}, "\n";
811                  #return $self->{node}->{source}->{ident};
812                  
813                };
814              
815    
816    #print Dumper($self->{node});
817              
818              # build callback map for helper function
819              #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
820              my $cbmap = {};
821              my $value = refexpr2perlref($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
822              $self->{node}->{source}->{propcache}->{value} = $value;
823            }
824    
825          # encode values dependent on type of underlying storage here - expand cases...          # encode values dependent on type of underlying storage here - expand cases...
826          my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};          my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
827          if ($storage_type eq 'DBI') {          if ($storage_type eq 'DBI') {
828            # ...for sql            # ...for sql
829            $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});            $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
830          } elsif ($storage_type eq 'Tangram') {          }
831             elsif ($storage_type eq 'Tangram') {
832              # iso? utf8 already possible?
833            
834          } elsif ($storage_type eq 'LDAP') {          } elsif ($storage_type eq 'LDAP') {
835            # TODO: encode utf8 here?            # TODO: encode utf8 here?
836          }          }
# Line 606  sub _buildMap { Line 841  sub _buildMap {
841        }        }
842      }      }
843    
 #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);  
         #}  
       }  
     }  
844            
845    # TODO: $logger->dump( ... );    # TODO: $logger->dump( ... );
846    #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );    #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
# Line 708  sub _modifyNode { Line 914  sub _modifyNode {
914      }      }
915    }    }
916        
917      
918      #print Dumper($self->{meta});
919    
920    # DBI speaks SQL    # DBI speaks SQL
921    if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {    if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {
# Line 721  sub _modifyNode { Line 929  sub _modifyNode {
929      #print $action, "\n";      #print $action, "\n";
930  #$action = "anc";  #$action = "anc";
931  #print "yai", "\n";  #print "yai", "\n";
932    
933    #print Dumper($map);
934    #delete $map->{cs};
935    
936      if (lc($action) eq 'insert') {      if (lc($action) eq 'insert') {
937        $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_INSERT');        $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_INSERT');
938      } elsif (lc $action eq 'update') {      } elsif (lc $action eq 'update') {
# Line 728  sub _modifyNode { Line 940  sub _modifyNode {
940        $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_UPDATE', $crit);        $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_UPDATE', $crit);
941      }      }
942    
943      #print "sql: ", $sql_main, "\n";  #$sql_main = "UPDATE currencies_csv SET oid='abcdef' WHERE text='Australian Dollar' AND key='AUD';";
944      #exit;  #$sql_main = "UPDATE currencies_csv SET oid='huhu2' WHERE ekey='AUD'";
945    
946    #print "sql: ", $sql_main, "\n";
947    #exit;
948    
949      # transfer data      # transfer data
950      my $sqlHandle = $self->{meta}->{$descent}->{storage}->sendCommand($sql_main);      my $sqlHandle = $self->{meta}->{$descent}->{storage}->sendCommand($sql_main);
951    
952    #exit;
953    
954      # handle errors      # handle errors
955      if ($sqlHandle->err) {      if ($sqlHandle->err) {
956        #if ($self->{args}->{debug}) { print "sql-error with statement: $sql_main", "\n"; }        #if ($self->{args}->{debug}) { print "sql-error with statement: $sql_main", "\n"; }
# Line 809  sub _modifyNode { Line 1026  sub _modifyNode {
1026        hash2object($object, $map);        hash2object($object, $map);
1027    
1028        # ... and re-update@orm.        # ... and re-update@orm.
1029    #print Dumper($object);
1030        $self->{meta}->{$descent}->{storage}->update($object);        $self->{meta}->{$descent}->{storage}->update($object);
1031    
1032        # asymmetry: get ident after insert        # asymmetry: get ident after insert
1033        # TODO:        # TODO:
1034        #   - just do this if it is an IdentAuthority        #   - just do this if it is an IdentAuthority
1035        #   - use IdentProvider metadata here        #   - use IdentProvider metadata here
1036        $self->{node}->{$descent}->{ident} = $self->{meta}->{$descent}->{storage}->id($object);  #print Dumper($self->{meta}->{$descent});
1037          my $oid = $self->{meta}->{$descent}->{storage}->id($object);
1038    #print "oid: $oid", "\n";
1039          $self->{node}->{$descent}->{ident} = $oid;
1040    
1041    
1042      } elsif (lc $action eq 'update') {      } elsif (lc $action eq 'update') {
# Line 912  sub _statloadNode { Line 1133  sub _statloadNode {
1133        #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";
1134        return;        return;
1135      }      }
1136        
1137        # patch for DBD::CSV
1138        if ($ident && $ident eq 'Null') {
1139          return;
1140        }
1141    
1142      my $result = $self->{meta}->{$descent}->{storage}->sendQuery({  #print "yai!", "\n";
1143    
1144        my $query = {
1145        node => $self->{meta}->{$descent}->{node},        node => $self->{meta}->{$descent}->{node},
1146        subnodes => [qw( cs )],        subnodes => [qw( cs )],
1147        criterias => [        criterias => [
# Line 921  sub _statloadNode { Line 1149  sub _statloadNode {
1149             op => 'eq',             op => 'eq',
1150             val => $ident },             val => $ident },
1151        ]        ]
1152      });      };
1153    
1154    #print Dumper($query);
1155    
1156        my $result = $self->{meta}->{$descent}->{storage}->sendQuery($query);
1157    
1158      my $entry = $result->getNextEntry();      my $entry = $result->getNextEntry();
1159    
1160    #print Dumper($entry);
1161    #print "pers: " . $self->{meta}->{$descent}->{storage}->is_persistent($entry), "\n";
1162    #my $state = $self->{meta}->{$descent}->{storage}->_fetch_object_state($entry, { name => 'TransactionHop' } );
1163    #print Dumper($state);
1164    
1165      my $status = $result->getStatus();      my $status = $result->getStatus();
1166    
1167    #print Dumper($status);
1168        
1169      # TODO: enhance error handling (store inside tc)      # TODO: enhance error handling (store inside tc)
1170      #if (!$row) {      #if (!$row) {
1171      #  print "\n", "row error", "\n";      #  print "\n", "row error", "\n";
1172      #  next;      #  next;
1173      #}      #}
1174      if (($status && $status->{err}) || !$entry) {  
1175        #$logger->critical( __PACKAGE__ . "->_loadNode (ident=\"$ident\") failed" );      # these checks run before actually loading payload- and meta-data to node-container
1176        return;      
1177      }        # 1st level - hard error
1178          if ($status && $status->{err}) {
1179            $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - hard error (that's ok): $status->{err}" );
1180            return;
1181          }
1182      
1183          # 2nd level - logical (empty/notfound) error
1184          if (($status && $status->{empty}) || !$entry) {
1185            $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - logical error (that's ok)" );
1186            #print "no entry (logical)", "\n";
1187            return;
1188          }
1189    
1190    #print Dumper($entry);
1191    
1192      # was:      # was:
1193      # $self->{node}->{$descent}->{ident} = $ident;        # $self->{node}->{$descent}->{ident} = $ident;  
1194      # is:      # is:
1195      # TODO: re-resolve ident from entry via metadata "IdentProvider"      # TODO: re-resolve ident from entry via metadata "IdentProvider" here - like elsewhere
1196      $self->{node}->{$descent}->{ident} = $ident;      $self->{node}->{$descent}->{ident} = $ident;
1197      $self->{node}->{$descent}->{payload} = $entry;      $self->{node}->{$descent}->{payload} = $entry;
1198    
1199    }    }
1200        
1201    return 1;    return 1;
# Line 964  sub _doModifySource_IdentChecksum { Line 1219  sub _doModifySource_IdentChecksum {
1219      $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,      $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,
1220      cs => $self->{node}->{target}->{checksum},      cs => $self->{node}->{target}->{checksum},
1221    };    };
1222    #print Dumper($map);  
1223    #print Dumper($self->{node});  #print Dumper($map);
1224    #exit;  #print Dumper($self->{node});
1225    #exit;
1226    
1227    $self->_modifyNode('source', 'update', $map);    $self->_modifyNode('source', 'update', $map);
1228  }  }
1229    
# Line 1048  sub _prepareNode_DummyIdent { Line 1305  sub _prepareNode_DummyIdent {
1305      }      }
1306      my $crit = join ' AND ', @crits;      my $crit = join ' AND ', @crits;
1307      print "p" if $self->{verbose};      print "p" if $self->{verbose};
1308    
1309    #print Dumper($map);
1310    #print Dumper($crit);
1311    
1312      $self->_modifyNode($descent, 'update', $map, $crit);      $self->_modifyNode($descent, 'update', $map, $crit);
1313      $i++;      $i++;
1314    }    }
# Line 1063  sub _prepareNode_DummyIdent { Line 1324  sub _prepareNode_DummyIdent {
1324  # 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)
1325  sub _otherSide {  sub _otherSide {
1326    my $self = shift;    my $self = shift;
1327    my $side = shift;    my $descent = shift;
1328    return 'source' if $side eq 'target';    return 'source' if $descent eq 'target';
1329    return 'target' if $side eq 'source';    return 'target' if $descent eq 'source';
1330    return '';    return '';
1331  }  }
1332    
1333    sub _erase_all {
1334      my $self = shift;
1335      my $descent = shift;
1336      #my $node = shift;
1337      my $node = $self->{meta}->{$descent}->{node};
1338      $self->{meta}->{$descent}->{storage}->eraseAll($node);
1339    }
1340    
1341    
1342  =pod  =pod
1343    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed