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

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

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