/[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.10 - (hide annotations)
Thu Dec 19 01:07:16 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.9: +5 -2 lines
+ fixed output done via $logger

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

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