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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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