/[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.7 - (hide annotations)
Fri Dec 13 21:49:34 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.6: +152 -9 lines
+ sub configure
+ sub checkOptions

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

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