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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations)
Mon Dec 16 07:02:34 2002 UTC (21 years, 6 months ago) by jonen
Branch: MAIN
Changes since 1.8: +6 -1 lines
+ added comment

1 jonen 1.9 ## $Id: Sync.pm,v 1.8 2002/12/15 02:03:09 joko Exp $
2 joko 1.1 ##
3     ## Copyright (c) 2002 Andreas Motl <andreas.motl@ilo.de>
4     ##
5     ## See COPYRIGHT section in pod text below for usage and distribution rights.
6     ##
7     ## ----------------------------------------------------------------------------------------
8 joko 1.2 ## $Log: Sync.pm,v $
9 jonen 1.9 ## Revision 1.8 2002/12/15 02:03:09 joko
10     ## + fixed logging-messages
11     ## + additional metadata-checks
12     ##
13 joko 1.8 ## Revision 1.7 2002/12/13 21:49:34 joko
14     ## + sub configure
15     ## + sub checkOptions
16     ##
17 joko 1.7 ## Revision 1.6 2002/12/06 04:49:10 jonen
18     ## + disabled output-puffer here
19     ##
20 jonen 1.6 ## 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 joko 1.5 ## Revision 1.4 2002/12/03 15:54:07 joko
26     ## + {import}-flag is now {prepare}-flag
27     ##
28 joko 1.4 ## Revision 1.3 2002/12/01 22:26:59 joko
29     ## + minor cosmetics for logging
30     ##
31 joko 1.3 ## 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 joko 1.2 ## Revision 1.1 2002/11/29 04:45:50 joko
40     ## + initial check in
41     ##
42 joko 1.1 ## Revision 1.1 2002/10/10 03:44:21 cvsjoko
43     ## + new
44     ## ----------------------------------------------------------------------------------------
45    
46    
47     package Data::Transfer::Sync;
48    
49     use strict;
50     use warnings;
51    
52     use Data::Dumper;
53 joko 1.7 #use Hash::Merge qw( merge );
54    
55 joko 1.1 use misc::HashExt;
56     use libp qw( md5_base64 );
57     use libdb qw( quotesql hash2Sql );
58 joko 1.2 use Data::Transform::Deep qw( hash2object refexpr2perlref );
59 joko 1.1 use Data::Compare::Struct qw( getDifference isEmpty );
60    
61     # get logger instance
62     my $logger = Log::Dispatch::Config->instance;
63    
64 jonen 1.6 $| = 1;
65 joko 1.1
66     sub new {
67     my $invocant = shift;
68     my $class = ref($invocant) || $invocant;
69 joko 1.7 my $self = {};
70 joko 1.1 $logger->debug( __PACKAGE__ . "->new(@_)" );
71     bless $self, $class;
72 joko 1.7 $self->configure(@_);
73 joko 1.1 return $self;
74     }
75    
76    
77 joko 1.7 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 joko 1.1 sub _init {
92     my $self = shift;
93 joko 1.7
94     $self->{configured} = 1;
95 joko 1.1
96     # build new container if necessary
97     $self->{container} = Data::Storage::Container->new() if !$self->{container};
98    
99     # add storages to container (optional)
100     foreach (keys %{$self->{storages}}) {
101     $self->{container}->addStorage($_, $self->{storages}->{$_});
102     }
103    
104     # tag storages with id-authority and checksum-provider information
105     # TODO: better store tag inside metadata to hold bits together!
106     map { $self->{container}->{storage}->{$_}->{isIdentAuthority} = 1 } @{$self->{id_authorities}};
107     map { $self->{container}->{storage}->{$_}->{isChecksumAuthority} = 1; } @{$self->{checksum_authorities}};
108     map { $self->{container}->{storage}->{$_}->{isWriteProtected} = 1; } @{$self->{write_protected}};
109    
110     }
111    
112    
113 joko 1.7 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 joko 1.1 # TODO: some feature to show off the progress of synchronization (cur/max * 100)
206     sub syncNodes {
207    
208     my $self = shift;
209     my $args = shift;
210    
211 joko 1.7 if (!$self->{configured}) {
212     $logger->critical( __PACKAGE__ . "->syncNodes: Synchronization object is not configured/initialized correctly." );
213     return;
214     }
215    
216 joko 1.1 # remember arguments through the whole processing
217     $self->{args} = $args;
218    
219     $logger->debug( __PACKAGE__ . "->syncNodes: starting" );
220    
221     # hash to hold and/or fill in metadata required for the processing
222     $self->{meta} = {};
223    
224     # hash to sum up results
225     my $direction_arrow = '';
226    
227     # detect synchronization method to determine which optical symbol (directed arrow) to use
228     if (lc $self->{args}->{direction} eq 'push') {
229     $direction_arrow = '->';
230     } elsif (lc $self->{args}->{direction} eq 'pull') {
231     $direction_arrow = '<-';
232     } elsif (lc $self->{args}->{direction} eq 'full') {
233     $direction_arrow = '<->';
234     } else {
235     }
236    
237     # decompose identifiers for each partner
238 joko 1.7 # TODO: refactor!!! take this list from already established/given metadata
239 joko 1.1 foreach ('source', 'target') {
240    
241     # get/set metadata for further processing
242    
243     # Partner and Node (e.g.: "L:Country" or "R:countries.csv")
244     if (my $item = $self->{args}->{$_}) {
245     my @item = split(':', $item);
246     $self->{meta}->{$_}->{dbkey} = $item[0];
247     $self->{meta}->{$_}->{node} = $item[1];
248     }
249    
250     # Filter
251     if (my $item_filter = $self->{args}->{$_ . '_filter'}) {
252     $self->{meta}->{$_}->{filter} = $item_filter;
253     }
254    
255     # IdentProvider
256     if (my $item_ident = $self->{args}->{$_ . '_ident'}) {
257     my @item_ident = split(':', $item_ident);
258     $self->{meta}->{$_}->{IdentProvider} = { method => $item_ident[0], arg => $item_ident[1] };
259     }
260    
261     # TODO: ChecksumProvider
262    
263     # exclude properties/subnodes
264     if (my $item_exclude = $self->{args}->{$_ . '_exclude'}) {
265     $self->{meta}->{$_}->{subnodes_exclude} = $item_exclude;
266     }
267    
268     # TypeProvider
269     if (my $item_type = $self->{args}->{$_ . '_type'}) {
270     my @item_type = split(':', $item_type);
271     $self->{meta}->{$_}->{TypeProvider} = { method => $item_type[0], arg => $item_type[1] };
272     }
273    
274     # Callbacks - writers (will be triggered _before_ writing to target)
275     if (my $item_writers = $self->{args}->{$_ . '_callbacks_write'}) {
276     my $descent = $_; # this is important since the following code inside the map wants to use its own context variables
277     map { $self->{meta}->{$descent}->{Callback}->{write}->{$_}++; } @$item_writers;
278     }
279    
280     # Callbacks - readers (will be triggered _after_ reading from source)
281     if (my $item_readers = $self->{args}->{$_ . '_callbacks_read'}) {
282     my $descent = $_;
283     map { $self->{meta}->{$descent}->{Callback}->{read}->{$_}++; } @$item_readers;
284     }
285    
286     # resolve storage objects
287     #$self->{$_} = $self->{container}->{storage}->{$self->{meta}->{$_}->{dbkey}};
288     # relink references to metainfo
289     $self->{meta}->{$_}->{storage} = $self->{container}->{storage}->{$self->{meta}->{$_}->{dbkey}};
290     #print "iiiiisprov: ", Dumper($self->{meta}->{$_}->{storage}), "\n";
291     }
292    
293 joko 1.7 #print Dumper($self->{meta});
294    
295 joko 1.1 $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
298 joko 1.2 # 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 joko 1.1 foreach (@{$self->{args}->{mapping}}) {
302 joko 1.2 if (ref $_ eq 'ARRAY') {
303     my @entry1 = split(':', $_->[0]);
304     my @entry2 = split(':', $_->[1]);
305     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 joko 1.1 }
321    
322 joko 1.7 #print Dumper($self->{meta});
323    
324 joko 1.1 # check partners/nodes: does partner exist / is node available?
325     foreach my $partner (keys %{$self->{meta}}) {
326 joko 1.8
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 joko 1.1 my $node = $self->{meta}->{$partner}->{node};
348     if (!$self->{meta}->{$partner}->{storage}->existsChildNode($node)) {
349 joko 1.8 $logger->critical( __PACKAGE__ . "->syncNodes: Could not reach node \"$node\" at partner \"$partner\"." );
350 joko 1.1 return;
351     }
352 joko 1.8
353 joko 1.1 }
354    
355     # TODO:
356     # + if action == PUSH: start processing
357     # -+ if action == PULL: swap metadata and start processing
358     # - if action == FULL: start processing, then swap metadata and (re-)start processing
359    
360     #print Dumper($self->{args});
361    
362     # manipulate metainfo according to direction of synchronization
363     if (lc $self->{args}->{direction} eq 'push') {
364     # just do it ...
365     } elsif (lc $self->{args}->{direction} eq 'pull') {
366     #print "=======SWAP", "\n";
367     # swap
368     ($self->{meta}->{source}, $self->{meta}->{target}) =
369     ($self->{meta}->{target}, $self->{meta}->{source});
370     } elsif (lc $self->{args}->{direction} eq 'full') {
371     } else {
372     }
373    
374     # 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
376 joko 1.4 if ($self->{args}->{prepare}) {
377 joko 1.1 $self->_prepareNode_MetaProperties('source');
378     $self->_prepareNode_DummyIdent('source');
379     #return;
380     #$self->_erase_all($opts->{source_node});
381     }
382    
383 joko 1.2 # 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 joko 1.1 $self->_syncNodes();
392    
393     }
394    
395    
396     # TODO: abstract the hardwired use of "source" and "target" in here somehow - hmmmm....... /(="§/%???
397     sub _syncNodes {
398    
399     my $self = shift;
400    
401     my $tc = OneLineDumpHash->new( {} );
402     my $results;
403    
404     # set of objects is already in $self->{args}
405     # TODO: make independent of the terminology "object..."
406     $results = $self->{args}->{objectSet} if $self->{args}->{objectSet};
407    
408     # apply filter
409     if (my $filter = $self->{meta}->{source}->{filter}) {
410     #print Dumper($filter);
411     #exit;
412     $results ||= $self->_getNodeList('source', $filter);
413     }
414    
415 joko 1.5 # get reference to node list from convenient method provided by CORE-HANDLE
416 joko 1.1 #$results ||= $self->{source}->getListUnfiltered($self->{meta}->{source}->{node});
417     #$results ||= $self->{meta}->{source}->{storage}->getListUnfiltered($self->{meta}->{source}->{node});
418     $results ||= $self->_getNodeList('source');
419    
420     # checkpoint: do we actually have a list to iterate through?
421     if (!$results || !@{$results}) {
422     $logger->notice( __PACKAGE__ . "->syncNodes: No nodes to synchronize." );
423     return;
424     }
425    
426     # dereference
427     my @results = @{$results};
428    
429     # iterate through set
430     foreach my $source_node_real (@results) {
431    
432     $tc->{total}++;
433    
434     #print "======================== iter", "\n";
435    
436     # clone object (in case we have to modify it here)
437     # TODO:
438     # - is a "deep_copy" needed here if occouring modifications take place?
439     # - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
440     # - after all, just take care for now that this object doesn't get updated!
441     my $source_node = $source_node_real;
442    
443     # modify entry - handle new style callbacks (the readers)
444     #print Dumper($source_node);
445     #exit;
446    
447     my $descent = 'source';
448    
449     # handle callbacks right now while scanning them (asymmetric to the writers)
450     my $map_callbacks = {};
451     if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
452    
453     my $error = 0;
454    
455     foreach my $node (keys %{$callbacks->{read}}) {
456    
457     my $object = $source_node;
458     my $value; # = $source_node->{$node};
459    
460     # ------------ half-redundant: make $self->callCallback($object, $value, $opts)
461     my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
462     my $evalstring = 'return ' . $perl_callback . '( { object => $object, property => $node, value => $value, storage => $self->{meta}->{$descent}->{storage} } );';
463     #print $evalstring, "\n"; exit;
464     my $cb_result = eval($evalstring);
465     if ($@) {
466     die $@;
467     $error = 1;
468     print $@, "\n";
469     }
470     # ------------ half-redundant: make $self->callCallback($object, $value, $opts)
471    
472     $source_node->{$node} = $cb_result;
473    
474     }
475    
476     }
477    
478     #print Dumper($source_node);
479    
480     # exclude defined fields (simply delete from object)
481     map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
482    
483     # here we accumulate information about the status of the current node (payload/row/object/item/entry)
484     $self->{node} = {};
485     $self->{node}->{source}->{payload} = $source_node;
486    
487     #print "res - ident", "\n";
488    
489     # determine ident of entry
490     my $identOK = $self->_resolveNodeIdent('source');
491     #if (!$identOK && lc $self->{args}->{direction} ne 'import') {
492     if (!$identOK) {
493 joko 1.5 #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 joko 1.1 return;
496     }
497    
498     #print "statload", "\n";
499     #print "ident: ", $self->{node}->{source}->{ident}, "\n";
500 joko 1.5 #print Dumper($self->{node});
501 joko 1.1
502     my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});
503 joko 1.5
504     #print Dumper($self->{node});
505 joko 1.1
506     # mark node as new either if there's no ident or if stat/load failed
507     if (!$statOK) {
508     $self->{node}->{status}->{new} = 1;
509     print "n" if $self->{verbose};
510     }
511    
512     #print "checksum", "\n";
513    
514     # determine status of entry by synchronization method
515     if ( (lc $self->{args}->{method} eq 'checksum') ) {
516     #if ( $statOK && (lc $self->{args}->{method} eq 'checksum') ) {
517     #if ( !$self->{node}->{status}->{new} && (lc $self->{args}->{method} eq 'checksum') ) {
518    
519     # TODO:
520     # is this really worth a "critical"???
521     # no - it should just be a debug appendix i believe
522    
523     #print "readcs", "\n";
524    
525     # calculate checksum of source node
526     #$self->_calcChecksum('source');
527     if (!$self->_readChecksum('source')) {
528     $logger->critical( __PACKAGE__ . "->_readChecksum: Could not find \"source\" entry with ident=\"$self->{node}->{source}->{ident}\"" );
529     $tc->{skip}++;
530     print "s" if $self->{verbose};
531     next;
532     }
533    
534     # get checksum from synchronization target
535     $self->_readChecksum('target');
536     #if (!$self->_readChecksum('target')) {
537     # $logger->critical( __PACKAGE__ . "->_readChecksum: Could not find \"target\" entry with ident=\"$self->{node}->{source}->{ident}\"" );
538     # next;
539     #}
540    
541     # pre flight check: do we actually have a checksum provided?
542     #if (!$self->{node}->{source}->{checksum}) {
543     # print "Source checksum for entry with ident \"$self->{node}->{source}->{ident}\" could not be calculated, maybe it's missing?.", "\n";
544     # return;
545     #}
546    
547     # determine if entry is "new" or "dirty"
548     # after all, this seems to be the point where the hammer falls.....
549     print "c" if $self->{verbose};
550     $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
551     if (!$self->{node}->{status}->{new}) {
552     $self->{node}->{status}->{dirty} =
553     $self->{node}->{status}->{new} ||
554     (!$self->{node}->{source}->{checksum} || !$self->{node}->{target}->{checksum}) ||
555     ($self->{node}->{source}->{checksum} ne $self->{node}->{target}->{checksum}) ||
556     $self->{args}->{force};
557     }
558    
559     }
560    
561     # first reaction on entry-status: continue with next entry if the current is already "in sync"
562     if (!$self->{node}->{status}->{new} && !$self->{node}->{status}->{dirty}) {
563     $tc->{in_sync}++;
564     next;
565     }
566    
567     # build map to actually transfer the data from source to target
568     $self->_buildMap();
569    
570    
571     #print Dumper($self->{node}); exit;
572    
573     #print "attempt", "\n";
574    
575     # additional (new) checks for feature "write-protection"
576     if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
577     $tc->{attempt_transfer}++;
578     print "\n" if $self->{verbose};
579     $logger->notice( __PACKAGE__ . "->syncNodes: Target is write-protected. Will not insert or modify node. " .
580     "(Ident: $self->{node}->{source}->{ident} " . "Dump:\n" . Dumper($self->{node}->{source}->{payload}) . ")" );
581     print "\n" if $self->{verbose};
582     $tc->{skip}++;
583     next;
584     }
585    
586     # transfer contents of map to target
587     if ($self->{node}->{status}->{new}) {
588     $tc->{attempt_new}++;
589     $self->_doTransferToTarget('insert');
590     # asymmetry: refetch node from target to re-calculate new ident and checksum (TODO: is IdentAuthority of relevance here?)
591 joko 1.5 #print Dumper($self->{node});
592 joko 1.1 $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);
593     $self->_readChecksum('target');
594    
595     } elsif ($self->{node}->{status}->{dirty}) {
596     $tc->{attempt_modify}++;
597     # asymmetry: get ident before updating (TODO: is IdentAuthority of relevance here?)
598     $self->{node}->{target}->{ident} = $self->{node}->{map}->{$self->{meta}->{target}->{IdentProvider}->{arg}};
599     $self->_doTransferToTarget('update');
600     $self->_readChecksum('target');
601     }
602    
603     if ($self->{node}->{status}->{ok}) {
604     $tc->{ok}++;
605     print "t" if $self->{verbose};
606     }
607    
608     if ($self->{node}->{status}->{error}) {
609     $tc->{error}++;
610     push( @{$tc->{error_per_row}}, $self->{node}->{status}->{error} );
611     print "e" if $self->{verbose};
612     }
613    
614     # 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
616     if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{storage}->{isIdentAuthority}) {
617 joko 1.5 print "r" if $self->{verbose};
618 joko 1.1 #print Dumper($self->{meta});
619     #print Dumper($self->{node});
620     #exit;
621     $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});
622     }
623    
624     print ":" if $self->{verbose};
625    
626     }
627    
628     print "\n" if $self->{verbose};
629    
630     # build user-message from some stats
631 joko 1.3 my $msg = "statistics: $tc";
632 joko 1.1
633     if ($tc->{error_per_row}) {
634     $msg .= "\n";
635 joko 1.2 $msg .= "errors from \"error_per_row\":" . "\n";
636 joko 1.1 $msg .= Dumper($tc->{error_per_row});
637     }
638    
639     # todo!!!
640     #sysevent( { usermsg => $msg, level => $level }, $taskEvent );
641     $logger->info( __PACKAGE__ . "->syncNodes: $msg" );
642    
643     return $tc;
644    
645     }
646    
647    
648 jonen 1.9 # refactor this as some core-function to do a generic dump resolving data-encapsulations of e.g. Set::Object
649 joko 1.1 sub _dumpCompact {
650     my $self = shift;
651    
652     #my $vars = \@_;
653     my @data = ();
654    
655     my $count = 0;
656     foreach (@_) {
657     my $item = {};
658     foreach my $key (keys %$_) {
659     my $val = $_->{$key};
660 joko 1.5
661     #print Dumper($val);
662    
663 joko 1.1 if (ref $val eq 'Set::Object') {
664     #print "========================= SET", "\n";
665 joko 1.5 #print Dumper($val);
666 joko 1.1 #print Dumper($val->members());
667     #$val = $val->members();
668     #$vars->[$count]->{$key} = $val->members() if $val->can("members");
669     #$item->{$key} = $val->members() if $val->can("members");
670     $item->{$key} = $val->members();
671     #print Dumper($vars->[$count]->{$key});
672 joko 1.5
673 joko 1.1 } else {
674     $item->{$key} = $val;
675     }
676 joko 1.5
677 joko 1.1 }
678     push @data, $item;
679     $count++;
680     }
681    
682 joko 1.5 #print "Dump:", Dumper(@data), "\n";
683 joko 1.1
684     $Data::Dumper::Indent = 0;
685     my $result = Dumper(@data);
686     $Data::Dumper::Indent = 2;
687     return $result;
688 joko 1.5
689 joko 1.1 }
690    
691    
692     sub _calcChecksum {
693    
694     my $self = shift;
695     my $descent = shift;
696     my $specifier = shift;
697    
698     # calculate checksum for current object
699     my $ident = $self->{node}->{$descent}->{ident};
700    
701     # build dump of this node
702     my $payload = $self->{node}->{$descent}->{payload};
703     #my $dump = $ident . "\n" . $item->quickdump();
704     #my $dump = $ident . "\n" . Dumper($item);
705     my $dump = $ident . "\n" . $self->_dumpCompact($payload);
706    
707     # TODO: $logger->dump( ... );
708     #$logger->debug( __PACKAGE__ . ": " . $dump );
709     #$logger->dump( __PACKAGE__ . ": " . $dump );
710    
711     # calculate checksum from dump
712     # md5-based fingerprint, base64 encoded (from Digest::MD5)
713     #my $checksum_cur = md5_base64($objdump) . '==';
714     # 32-bit integer "hash" value (maybe faster?) (from DBI)
715     $self->{node}->{$descent}->{checksum} = DBI::hash($dump, 1);
716    
717     # signal good
718     return 1;
719    
720     }
721    
722    
723     sub _readChecksum {
724     my $self = shift;
725    
726     my $descent = shift;
727    
728     #print "getcheck:", "\n"; print Dumper($self->{node}->{$descent});
729    
730     if (!$self->{node}->{$descent}) {
731     # signal checksum bad
732     return;
733     }
734    
735     # get checksum for current entry
736     # TODO: don't have the checksum column/property hardcoded as "cs" here, make this configurable somehow
737    
738     if ($self->{meta}->{$descent}->{storage}->{isChecksumAuthority}) {
739     #$self->{node}->{$descent}->{checksum} = $entry->{cs};
740     #$self->{node}->{$descent}->{checksum} = $self->_calcChecksum($descent); # $entry->{cs};
741     #print "descent: $descent", "\n";
742     $self->_calcChecksum($descent);
743     #print "checksum: ", $self->{node}->{$descent}->{checksum}, "\n";
744     } else {
745    
746     #$self->{node}->{$descent}->{checksum} = $entry->{cs};
747     $self->{node}->{$descent}->{checksum} = $self->{node}->{$descent}->{payload}->{cs};
748     }
749    
750     # signal checksum good
751     return 1;
752    
753     }
754    
755    
756     sub _buildMap {
757    
758     my $self = shift;
759    
760     # field-structure for building sql
761     # mapping of sql-fieldnames to object-attributes
762     $self->{node}->{map} = {};
763    
764     # manually set ...
765     # ... object-id
766     $self->{node}->{map}->{$self->{meta}->{target}->{IdentProvider}->{arg}} = $self->{node}->{source}->{ident};
767     # ... checksum
768     $self->{node}->{map}->{cs} = $self->{node}->{source}->{checksum};
769    
770     #print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
771    
772     # for transferring flat structures via simple (1:1) mapping
773     # TODO: diff per property / property value
774    
775     if ($self->{args}->{mapping}) {
776     # apply mapping from $self->{args}->{mapping} to $self->{node}->{map}
777     #foreach my $key (@{$self->{meta}->{source}->{childnodes}}) {
778     my @childnodes = @{$self->{meta}->{source}->{childnodes}};
779     for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
780     #my $map_right = $self->{args}->{mapping}->{$key};
781    
782 joko 1.2 $self->{node}->{source}->{propcache} = {};
783     $self->{node}->{target}->{propcache} = {};
784    
785 joko 1.1 # get property name
786     $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
787     $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];
788     #print "map: $map_right", "\n";
789    
790     # get property value
791     my $value;
792    
793     # detect for callback - old style - (maybe the better???)
794     if (ref($self->{node}->{target}->{map}) eq 'CODE') {
795     #$value = &$map_right($objClone);
796     } else {
797     # plain (scalar?) value
798     #$value = $objClone->{$map_right};
799     $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};
800     }
801     #$self->{node}->{map}->{$key} = $value;
802 joko 1.2
803     # detect expression
804     # for transferring deeply nested structures described by expressions
805     #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
806     if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
807    
808     # create an anonymous sub to act as callback target dispatcher
809     my $cb_dispatcher = sub {
810     #print "=============== CALLBACK DISPATCHER", "\n";
811     #print "ident: ", $self->{node}->{source}->{ident}, "\n";
812     #return $self->{node}->{source}->{ident};
813    
814     };
815    
816    
817     #print Dumper($self->{node});
818    
819     # build callback map for helper function
820     #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
821     my $cbmap = {};
822     my $value = refexpr2perlref($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
823     $self->{node}->{source}->{propcache}->{value} = $value;
824     }
825 joko 1.1
826     # encode values dependent on type of underlying storage here - expand cases...
827     my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
828     if ($storage_type eq 'DBI') {
829     # ...for sql
830     $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
831 joko 1.2 }
832     elsif ($storage_type eq 'Tangram') {
833     # iso? utf8 already possible?
834    
835 joko 1.1 } elsif ($storage_type eq 'LDAP') {
836     # TODO: encode utf8 here?
837     }
838    
839     # store value to transfer map
840     $self->{node}->{map}->{$self->{node}->{target}->{propcache}->{property}} = $self->{node}->{source}->{propcache}->{value};
841    
842     }
843     }
844    
845    
846     # TODO: $logger->dump( ... );
847     #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
848     #print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
849     #print "entrystatus: ", Dumper($self->{node}), "\n";
850    
851     }
852    
853     sub _resolveNodeIdent {
854     my $self = shift;
855     my $descent = shift;
856    
857     #print Dumper($self->{node}->{$descent});
858    
859     # get to the payload
860     #my $item = $specifier->{item};
861     my $payload = $self->{node}->{$descent}->{payload};
862    
863     # resolve method to get to the id of the given item
864     # we use global metadata and the given descent for this task
865     #my $ident = $self->{$descent}->id($item);
866     #my $ident = $self->{meta}->{$descent}->{storage}->id($item);
867    
868     my $ident;
869     my $provider_method = $self->{meta}->{$descent}->{IdentProvider}->{method};
870     my $provider_arg = $self->{meta}->{$descent}->{IdentProvider}->{arg};
871    
872     # resolve to ident
873     if ($provider_method eq 'property') {
874     $ident = $payload->{$provider_arg};
875    
876     } elsif ($provider_method eq 'storage_method') {
877     #$ident = $self->{meta}->{$descent}->{storage}->id($item);
878     $ident = $self->{meta}->{$descent}->{storage}->$provider_arg($payload);
879     }
880    
881     $self->{node}->{$descent}->{ident} = $ident;
882    
883     return 1 if $ident;
884    
885     }
886    
887    
888     sub _modifyNode {
889     my $self = shift;
890     my $descent = shift;
891     my $action = shift;
892     my $map = shift;
893     my $crit = shift;
894    
895     # map for new style callbacks
896     my $map_callbacks = {};
897    
898     # checks go first!
899    
900     # TODO: this should be reviewed first - before extending ;-)
901     # TODO: this should be extended:
902     # count this cases inside the caller to this sub and provide a better overall message
903     # if this counts still zero in the end:
904     # "No nodes have been touched for modify: Do you have column-headers in your csv file?"
905     if (not defined $self->{node}) {
906     #$logger->critical( __PACKAGE__ . "->_modifyNode failed: \"$descent\" node is empty." );
907     #return;
908     }
909    
910     # transfer callback nodes from value map to callback map - handle them afterwards! - (new style callbacks)
911     if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
912     foreach my $callback (keys %{$callbacks->{write}}) {
913     $map_callbacks->{write}->{$callback} = $map->{$callback};
914     delete $map->{$callback};
915     }
916     }
917    
918 joko 1.5
919     #print Dumper($self->{meta});
920 joko 1.1
921     # DBI speaks SQL
922     if ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'DBI') {
923    
924     #print Dumper($self->{node});
925     my $sql_main;
926     # translate map to sql
927     #print $action, "\n"; exit;
928     #print $self->{meta}->{$descent}->{node}, "\n"; exit;
929     #print "action:";
930     #print $action, "\n";
931     #$action = "anc";
932     #print "yai", "\n";
933 joko 1.7
934     #print Dumper($map);
935     #delete $map->{cs};
936    
937 joko 1.1 if (lc($action) eq 'insert') {
938     $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_INSERT');
939     } elsif (lc $action eq 'update') {
940     $crit ||= "$self->{meta}->{$descent}->{IdentProvider}->{arg}='$self->{node}->{$descent}->{ident}'";
941     $sql_main = hash2Sql($self->{meta}->{$descent}->{node}, $map, 'SQL_UPDATE', $crit);
942     }
943    
944 joko 1.7 #$sql_main = "UPDATE currencies_csv SET oid='abcdef' WHERE text='Australian Dollar' AND key='AUD';";
945     #$sql_main = "UPDATE currencies_csv SET oid='huhu2' WHERE ekey='AUD'";
946    
947     #print "sql: ", $sql_main, "\n";
948     #exit;
949 joko 1.1
950     # transfer data
951     my $sqlHandle = $self->{meta}->{$descent}->{storage}->sendCommand($sql_main);
952    
953 joko 1.7 #exit;
954    
955 joko 1.1 # handle errors
956     if ($sqlHandle->err) {
957     #if ($self->{args}->{debug}) { print "sql-error with statement: $sql_main", "\n"; }
958     $self->{node}->{status}->{error} = {
959     statement => $sql_main,
960     state => $sqlHandle->state,
961     err => $sqlHandle->err,
962     errstr => $sqlHandle->errstr,
963     };
964     } else {
965     $self->{node}->{status}->{ok} = 1;
966     }
967    
968     # Tangram does it the oo-way (naturally)
969     } elsif ($self->{meta}->{$descent}->{storage}->{locator}->{type} eq 'Tangram') {
970     my $sql_main;
971     my $object;
972    
973     # determine classname
974     my $classname = $self->{meta}->{$descent}->{node};
975    
976     # properties to exclude
977     my @exclude = @{$self->{meta}->{$descent}->{subnodes_exclude}};
978    
979    
980     if (my $identProvider = $self->{meta}->{$descent}->{IdentProvider}) {
981     push @exclude, $identProvider->{arg};
982     }
983    
984     # new feature:
985     # - check TypeProvider metadata property from other side
986     # - use argument (arg) inside as a classname for object creation on this side
987     #my $otherSide = $self->_otherSide($descent);
988     if (my $typeProvider = $self->{meta}->{$descent}->{TypeProvider}) {
989     #print Dumper($map);
990     $classname = $map->{$typeProvider->{arg}};
991     # remove nodes from map also (push nodes to "subnodes_exclude" list)
992     push @exclude, $typeProvider->{arg};
993     }
994    
995     # exclude banned properties (remove from map)
996     #map { delete $self->{node}->{map}->{$_} } @{$self->{args}->{exclude}};
997     map { delete $map->{$_} } @exclude;
998    
999     # list of properties
1000     my @props = keys %{$map};
1001    
1002     # transfer data
1003     if (lc $action eq 'insert') {
1004    
1005     # build array to initialize object
1006     #my @initarray = ();
1007     #map { push @initarray, $_, undef; } @props;
1008    
1009     # make the object persistent in four steps:
1010     # - raw create (perl / class tangram scope)
1011     # - engine insert (tangram scope) ... this establishes inheritance - don't try to fill in inherited properties before!
1012     # - raw fill-in from hash (perl scope)
1013     # - engine update (tangram scope) ... this updates all properties just filled in
1014    
1015     # create new object ...
1016     #my $object = $classname->new( @initarray );
1017     $object = $classname->new();
1018    
1019     # ... pass to orm ...
1020     $self->{meta}->{$descent}->{storage}->insert($object);
1021    
1022     # ... and initialize with empty (undef'd) properties.
1023     #print Dumper(@props);
1024     map { $object->{$_} = undef; } @props;
1025    
1026     # mix in values ...
1027     hash2object($object, $map);
1028    
1029     # ... and re-update@orm.
1030 joko 1.5 #print Dumper($object);
1031 joko 1.1 $self->{meta}->{$descent}->{storage}->update($object);
1032    
1033     # asymmetry: get ident after insert
1034     # TODO:
1035     # - just do this if it is an IdentAuthority
1036     # - use IdentProvider metadata here
1037 joko 1.5 #print Dumper($self->{meta}->{$descent});
1038     my $oid = $self->{meta}->{$descent}->{storage}->id($object);
1039     #print "oid: $oid", "\n";
1040     $self->{node}->{$descent}->{ident} = $oid;
1041 joko 1.1
1042    
1043     } elsif (lc $action eq 'update') {
1044    
1045     # get fresh object from orm first
1046     $object = $self->{meta}->{$descent}->{storage}->load($self->{node}->{$descent}->{ident});
1047    
1048     #print Dumper($self->{node});
1049    
1050     # mix in values
1051     #print Dumper($object);
1052     hash2object($object, $map);
1053     #print Dumper($object);
1054     #exit;
1055     $self->{meta}->{$descent}->{storage}->update($object);
1056     }
1057    
1058     my $error = 0;
1059    
1060     # handle new style callbacks - this is a HACK - do this without an eval!
1061     #print Dumper($map);
1062     #print "cb: ", Dumper($self->{meta}->{$descent}->{Callback});
1063     #print Dumper($map_callbacks);
1064     foreach my $node (keys %{$map_callbacks->{write}}) {
1065     #print Dumper($node);
1066     my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_write';
1067     my $evalstring = $perl_callback . '( { object => $object, value => $map_callbacks->{write}->{$node}, storage => $self->{meta}->{$descent}->{storage} } );';
1068     #print $evalstring, "\n"; exit;
1069     eval($evalstring);
1070     if ($@) {
1071     $error = 1;
1072     print $@, "\n";
1073     }
1074    
1075     #print "after eval", "\n";
1076    
1077     if (!$error) {
1078     # re-update@orm
1079     $self->{meta}->{$descent}->{storage}->update($object);
1080     }
1081     }
1082    
1083     # handle errors
1084     if ($error) {
1085     #print "error", "\n";
1086     =pod
1087     my $sqlHandle;
1088     #if ($self->{args}->{debug}) { print "sql-error with statement: $sql_main", "\n"; }
1089     $self->{node}->{status}->{error} = {
1090     statement => $sql_main,
1091     state => $sqlHandle->state,
1092     err => $sqlHandle->err,
1093     errstr => $sqlHandle->errstr,
1094     };
1095     =cut
1096     # rollback....
1097     #print "rollback", "\n";
1098     $self->{meta}->{$descent}->{storage}->erase($object);
1099     #print "after rollback", "\n";
1100     } else {
1101     $self->{node}->{status}->{ok} = 1;
1102     }
1103    
1104    
1105     }
1106    
1107     }
1108    
1109     # TODO:
1110     # this should be split up into...
1111     # - a "_statNode" (should just touch the node to check for existance)
1112     # - a "_loadNode" (should load node completely)
1113     # - maybe additionally a "loadNodeProperty" (may specify properties to load)
1114     # - introduce $self->{nodecache} for this purpose
1115     # TODO:
1116     # should we:
1117     # - not pass ident in here but resolve it via "$descent"?
1118     # - refactor this and stuff it with additional debug/error message
1119     # - this = the way the implicit load mechanism works
1120     sub _statloadNode {
1121    
1122     my $self = shift;
1123     my $descent = shift;
1124     my $ident = shift;
1125     my $force = shift;
1126    
1127     # fetch entry to retrieve checksum from
1128     # was:
1129     if (!$self->{node}->{$descent} || $force) {
1130     # is:
1131     #if (!$self->{node}->{$descent}->{item} || $force) {
1132    
1133     if (!$ident) {
1134     #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";
1135     return;
1136     }
1137 joko 1.5
1138     # patch for DBD::CSV
1139     if ($ident && $ident eq 'Null') {
1140     return;
1141     }
1142 joko 1.1
1143 joko 1.7 #print "yai!", "\n";
1144    
1145     my $query = {
1146 joko 1.1 node => $self->{meta}->{$descent}->{node},
1147     subnodes => [qw( cs )],
1148     criterias => [
1149     { key => $self->{meta}->{$descent}->{IdentProvider}->{arg},
1150     op => 'eq',
1151     val => $ident },
1152     ]
1153 joko 1.7 };
1154    
1155     #print Dumper($query);
1156    
1157     my $result = $self->{meta}->{$descent}->{storage}->sendQuery($query);
1158 joko 1.1
1159     my $entry = $result->getNextEntry();
1160 joko 1.7
1161     #print Dumper($entry);
1162     #print "pers: " . $self->{meta}->{$descent}->{storage}->is_persistent($entry), "\n";
1163     #my $state = $self->{meta}->{$descent}->{storage}->_fetch_object_state($entry, { name => 'TransactionHop' } );
1164     #print Dumper($state);
1165    
1166 joko 1.1 my $status = $result->getStatus();
1167    
1168 joko 1.5 #print Dumper($status);
1169    
1170 joko 1.1 # TODO: enhance error handling (store inside tc)
1171     #if (!$row) {
1172     # print "\n", "row error", "\n";
1173     # next;
1174     #}
1175 joko 1.5
1176     # these checks run before actually loading payload- and meta-data to node-container
1177    
1178     # 1st level - hard error
1179     if ($status && $status->{err}) {
1180 joko 1.7 $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - hard error (that's ok): $status->{err}" );
1181 joko 1.5 return;
1182     }
1183    
1184     # 2nd level - logical (empty/notfound) error
1185     if (($status && $status->{empty}) || !$entry) {
1186     $logger->debug( __PACKAGE__ . "->_statloadNode (ident=\"$ident\") failed - logical error (that's ok)" );
1187     #print "no entry (logical)", "\n";
1188     return;
1189     }
1190    
1191     #print Dumper($entry);
1192    
1193 joko 1.1 # was:
1194     # $self->{node}->{$descent}->{ident} = $ident;
1195     # is:
1196 joko 1.5 # TODO: re-resolve ident from entry via metadata "IdentProvider" here - like elsewhere
1197 joko 1.1 $self->{node}->{$descent}->{ident} = $ident;
1198     $self->{node}->{$descent}->{payload} = $entry;
1199 joko 1.5
1200 joko 1.1 }
1201    
1202     return 1;
1203    
1204     }
1205    
1206     sub _doTransferToTarget {
1207     my $self = shift;
1208     my $action = shift;
1209     $self->_modifyNode('target', $action, $self->{node}->{map});
1210     }
1211    
1212     sub _doModifySource_IdentChecksum {
1213     my $self = shift;
1214     my $ident_new = shift;
1215     # this changes an old node to a new one including ident and checksum
1216     # TODO:
1217     # - eventually introduce an external resource to store this data to
1218     # - we won't have to "re"-modify the source node here
1219     my $map = {
1220     $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,
1221     cs => $self->{node}->{target}->{checksum},
1222     };
1223 joko 1.5
1224     #print Dumper($map);
1225     #print Dumper($self->{node});
1226     #exit;
1227    
1228 joko 1.1 $self->_modifyNode('source', 'update', $map);
1229     }
1230    
1231    
1232     # this is a shortcut method
1233     # ... let's try to avoid _any_ redundant code in here (ok... - at the cost of method lookups...)
1234     sub _getNodeList {
1235     my $self = shift;
1236     my $descent = shift;
1237     my $filter = shift;
1238     return $self->{meta}->{$descent}->{storage}->getListFiltered($self->{meta}->{$descent}->{node}, $filter);
1239     }
1240    
1241    
1242     sub _prepareNode_MetaProperties {
1243     my $self = shift;
1244     my $descent = shift;
1245    
1246     $logger->info( __PACKAGE__ . "->_prepareNode_MetaProperties( descent $descent )" );
1247    
1248     # TODO: this should (better) be: "my $firstnode = $self->_getFirstNode($descent);"
1249     my $list = $self->_getNodeList($descent);
1250    
1251     # get first node
1252     my $firstnode = $list->[0];
1253    
1254     # check if node contains meta properties/nodes
1255     # TODO: "cs" is hardcoded here!
1256     my @required = ( $self->{meta}->{$descent}->{IdentProvider}->{arg}, 'cs' );
1257     my @found = keys %$firstnode;
1258     #my @diff = getDifference(\@found, \@required);
1259     my $diff = getDifference(\@required, \@found);
1260     #print Dumper(@found);
1261     #print Dumper(@required);
1262     #print Dumper(@diff);
1263     #if (!$#diff || $#diff == -1) {
1264     if (isEmpty($diff)) {
1265     $logger->warning( __PACKAGE__ . "->_prepareNode_MetaProperties: node is lacking meta properties - will try to alter..." );
1266     foreach (@required) {
1267     my $sql = "ALTER TABLE $self->{meta}->{$descent}->{node} ADD COLUMN $_";
1268     #print "sql: $sql", "\n";
1269     my $res = $self->{meta}->{$descent}->{storage}->sendCommand($sql);
1270     #print Dumper($res->getStatus());
1271     }
1272     }
1273    
1274     }
1275    
1276     sub _prepareNode_DummyIdent {
1277     my $self = shift;
1278     my $descent = shift;
1279    
1280     $logger->info( __PACKAGE__ . "->_prepareNode_DummyIdent( descent $descent )" );
1281    
1282     my $list = $self->_getNodeList($descent);
1283     #print Dumper($list);
1284     my $i = 0;
1285     my $ident_base = 5678983;
1286     my $ident_appendix = '0001';
1287     foreach my $node (@$list) {
1288     my $ident_dummy = $i + $ident_base;
1289     $ident_dummy .= $ident_appendix;
1290     my $map = {
1291     $self->{meta}->{$descent}->{IdentProvider}->{arg} => $ident_dummy,
1292     cs => undef,
1293     };
1294    
1295     # diff lists and ...
1296     my $diff = getDifference([keys %$node], [keys %$map]);
1297     next if $#{$diff} == -1;
1298    
1299     # ... build criteria including all columns
1300     my @crits;
1301     foreach my $property (@$diff) {
1302     next if !$property;
1303     my $value = $node->{$property};
1304     next if !$value;
1305     push @crits, "$property='" . quotesql($value) . "'";
1306     }
1307     my $crit = join ' AND ', @crits;
1308     print "p" if $self->{verbose};
1309 joko 1.5
1310     #print Dumper($map);
1311     #print Dumper($crit);
1312    
1313 joko 1.1 $self->_modifyNode($descent, 'update', $map, $crit);
1314     $i++;
1315     }
1316    
1317     print "\n" if $self->{verbose};
1318    
1319     if (!$i) {
1320     $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );
1321     }
1322    
1323     }
1324    
1325     # TODO: handle this in an abstract way (wipe out use of 'source' and/or 'target' inside core)
1326     sub _otherSide {
1327     my $self = shift;
1328 joko 1.2 my $descent = shift;
1329     return 'source' if $descent eq 'target';
1330     return 'target' if $descent eq 'source';
1331 joko 1.1 return '';
1332 joko 1.2 }
1333    
1334     sub _erase_all {
1335     my $self = shift;
1336     my $descent = shift;
1337     #my $node = shift;
1338     my $node = $self->{meta}->{$descent}->{node};
1339     $self->{meta}->{$descent}->{storage}->eraseAll($node);
1340 joko 1.1 }
1341    
1342    
1343     =pod
1344    
1345    
1346     =head1 DESCRIPTION
1347    
1348     Data::Transfer::Sync is a module providing a generic synchronization process
1349     across arbitrary/multiple storages based on a ident/checksum mechanism.
1350     It sits on top of Data::Storage.
1351    
1352    
1353     =head1 REQUIREMENTS
1354    
1355     For full functionality:
1356     Data::Storage
1357     Data::Transform
1358     Data::Compare
1359     ... and all their dependencies
1360    
1361    
1362     =head1 AUTHORS / COPYRIGHT
1363    
1364     The Data::Storage module is Copyright (c) 2002 Andreas Motl.
1365     All rights reserved.
1366    
1367     You may distribute it under the terms of either the GNU General Public
1368     License or the Artistic License, as specified in the Perl README file.
1369    
1370    
1371     =head1 SUPPORT / WARRANTY
1372    
1373     Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.
1374    
1375    
1376    
1377     =head1 BUGS
1378    
1379     When in "import" mode for windows file - DBD::AutoCSV may hang.
1380     Hint: Maybe the source node contains an ident-, but no checksum-column?
1381    
1382    
1383     =head1 USER LEVEL ERRORS
1384    
1385     =head4 Mapping
1386    
1387     - - - - - - - - - - - - - - - - - - - - - - - - - -
1388     info: BizWorks::Process::Setup->syncResource( source_node Currency mode PULL erase 0 import 0 )critical: BizWorks::Process::Setup->startSync: Can't access mapping for node "Currency" - please check BizWorks::ResourceMapping.
1389     - - - - - - - - - - - - - - - - - - - - - - - - - -
1390     You have to create a sub for each node used in synchronization inside named Perl module. The name of this sub _must_ match
1391     the name of the node you want to sync. This sub holds mapping metadata to give the engine hints about how
1392     to access the otherwise generic nodes.
1393     - - - - - - - - - - - - - - - - - - - - - - - - - -
1394    
1395    
1396     =head4 DBD::AutoCSV's rulebase
1397    
1398     - - - - - - - - - - - - - - - - - - - - - - - - - -
1399     info: BizWorks::Process::Setup->syncResource( source_node Currency mode PULL erase 0 import 0 )
1400     info: Data::Transfer::Sync->syncNodes: source=L/Currency <- target=R/currencies.csv
1401    
1402     Execution ERROR: Error while scanning: Missing first row or scanrule not applied. at C:/home/amo/develop/netfrag.org/nfo/perl/libs/DBD/CSV.p
1403     m line 165, <GEN9> line 1.
1404     called from C:/home/amo/develop/netfrag.org/nfo/perl/libs/Data/Storage/Handler/DBI.pm at 123.
1405    
1406     DBI-Error: DBD::AutoCSV::st fetchrow_hashref failed: Attempt to fetch row from a Non-SELECT statement
1407     notice: Data::Transfer::Sync->syncNodes: No nodes to synchronize.
1408     - - - - - - - - - - - - - - - - - - - - - - - - - -
1409     DBD::AutoCSV contains a rulebase which is spooled down while attempting to guess the style of the csv file regarding
1410     parameters like newline (eol), column-seperation-character (sep_char), quoting character (quote_char).
1411     If this spool runs out of entries and no style could be resolved, DBD::CSV dies causing this "Execution ERROR" which
1412     results in a "DBI-Error" afterwards.
1413     - - - - - - - - - - - - - - - - - - - - - - - - - -
1414    
1415    
1416     =head4 Check structure of source node
1417    
1418     - - - - - - - - - - - - - - - - - - - - - - - - - -
1419     info: Data::Transfer::Sync->syncNodes: source=L/Currency <- target=R/currencies.csv
1420     critical: Data::Transfer::Sync->syncNodes: Can not synchronize: No ident found in source node, maybe try to "import" this node first.
1421     - - - - - - - - - - - - - - - - - - - - - - - - - -
1422     If lowlevel detection succeeds, but no other required informations are found, this message is issued.
1423     "Other informations" might be:
1424     - column-header-row completely missing
1425     - ident column is empty
1426     - - - - - - - - - - - - - - - - - - - - - - - - - -
1427    
1428    
1429     =head4 Modify structure of source node
1430    
1431     - - - - - - - - - - - - - - - - - - - - - - - - - -
1432     info: Data::Transfer::Sync->syncNodes: source=L/Currency <- target=R/currencies.csv
1433     info: Data::Transfer::Sync->_prepareNode_MetaProperties( descent source )
1434     warning: Data::Transfer::Sync->_prepareNode_MetaProperties: node is lacking meta properties - will try to alter...
1435     SQL ERROR: Command 'ALTER' not recognized or not supported!
1436    
1437     SQL ERROR: Command 'ALTER' not recognized or not supported!
1438     - - - - - - - - - - - - - - - - - - - - - - - - - -
1439     The Engine found a node which structure does not match the required. It tries to alter this automatically - only when doing "import" -
1440     but the DBD driver (in this case DBD::CSV) gets in the way croaking not to be able to do this.
1441     This could also appear if your database connection has insufficient rights to modify the database structure.
1442     DBD::CSV croaks because it doesn't implement the ALTER command, so please edit your columns manually.
1443     Hint: Add columns with the names of your "ident" and "checksum" property specifications.
1444     - - - - - - - - - - - - - - - - - - - - - - - - - -
1445    
1446    
1447     =head4 Load source node by ident
1448    
1449     - - - - - - - - - - - - - - - - - - - - - - - - - -
1450     info: Data::Transfer::Sync->_prepareNode_DummyIdent( descent source )
1451     pcritical: Data::Transfer::Sync->_modifyNode failed: "source" node is empty.
1452     - - - - - - - - - - - - - - - - - - - - - - - - - -
1453     The source node could not be loaded. Maybe the ident is missing. Please check manually.
1454     Hint: Like above, the ident and/or checksum columns may be missing....
1455     - - - - - - - - - - - - - - - - - - - - - - - - - -
1456    
1457    
1458     =head1 TODO
1459    
1460     - sub _resolveIdentProvider
1461     - wrap _doModifySource and _doTransferTarget around a core function which can change virtually any type of node
1462     - split this module up into Sync.pm, Sync/Core.pm, Sync/Compare.pm and Sync/Compare/Checksum.pm
1463     - introduce _compareNodes as a core method and wrap it around methods in Sync/Compare/Checksum.pm
1464     - introduce Sync/Compare/MyComparisonImplementation.pm
1465     - some generic deferring method - e.g. "$self->defer(action)" - to be able to accumulate a bunch of actions for later processing
1466     - this implies everything done is _really_ split up into generic actions - how else would we defer them???
1467     - example uses:
1468     - fetch whole checksum list from node
1469     - remember source ident retransmits
1470     - remember: this is convenient - and maybe / of course faster - but we'll loose "per-node-atomic" operations
1471     - feature: mechanism to implicit inject checksum property to nodes (alter table / modify schema)
1472     - expand statistics / keep track of:
1473     - touched/untouched nodes
1474     - full sync
1475     - just do a push and a pull for now but use stats for touched nodes in between to speed up things
1476     - introduce some new metadata flags for a synchronization partner which is (e.g.) of "source" or "target":
1477     - isNewNodePropagator
1478     - isWriteProtected
1479    
1480    
1481     =cut
1482    
1483     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed