/[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.8 - (show annotations)
Sun Dec 15 02:03:09 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.7: +28 -3 lines
+ fixed logging-messages
+ additional metadata-checks

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

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