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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations)
Wed Jun 25 23:03:57 2003 UTC (21 years ago) by joko
Branch: MAIN
Changes since 1.9: +6 -1 lines
no debugging

1 ## -------------------------------------------------------------------------
2 ##
3 ## $Id: Core.pm,v 1.9 2003/05/13 08:17:52 joko Exp $
4 ##
5 ## Copyright (c) 2002 Andreas Motl <andreas.motl@ilo.de>
6 ##
7 ## See COPYRIGHT section in pod text below for usage and distribution rights.
8 ##
9 ## -------------------------------------------------------------------------
10 ## $Log: Core.pm,v $
11 ## Revision 1.9 2003/05/13 08:17:52 joko
12 ## buildAttributeMap now propagates error
13 ##
14 ## Revision 1.8 2003/03/27 15:31:15 joko
15 ## fixes to modules regarding new namespace(s) below Data::Mungle::*
16 ##
17 ## Revision 1.7 2003/02/21 08:01:11 joko
18 ## debugging, logging
19 ## renamed module
20 ##
21 ## Revision 1.6 2003/02/14 14:03:49 joko
22 ## + logging, debugging
23 ## - refactored code to sister module
24 ##
25 ## Revision 1.5 2003/02/11 05:30:47 joko
26 ## + minor fixes and some debugging mud
27 ##
28 ## Revision 1.4 2003/02/09 05:01:10 joko
29 ## + major structure changes
30 ## - refactored code to sister modules
31 ##
32 ## Revision 1.3 2003/01/20 17:01:14 joko
33 ## + cosmetics and debugging
34 ## + probably refactored code to new plugin-modules 'Metadata.pm' and/or 'StorageInterface.pm' (guess it was the last one...)
35 ##
36 ## Revision 1.2 2003/01/19 02:05:42 joko
37 ## - removed pod-documentation: now in Data/Transfer/Sync.pod
38 ##
39 ## Revision 1.1 2003/01/19 01:23:04 joko
40 ## + new from Data/Transfer/Sync.pm
41 ##
42 ## Revision 1.11 2002/12/23 07:10:59 joko
43 ## + using MD5 for checksum generation again - the 32-bit integer hash from DBI seems to be too lazy
44 ##
45 ## Revision 1.10 2002/12/19 01:07:16 joko
46 ## + fixed output done via $logger
47 ##
48 ## Revision 1.9 2002/12/16 07:02:34 jonen
49 ## + added comment
50 ##
51 ## Revision 1.8 2002/12/15 02:03:09 joko
52 ## + fixed logging-messages
53 ## + additional metadata-checks
54 ##
55 ## Revision 1.7 2002/12/13 21:49:34 joko
56 ## + sub configure
57 ## + sub checkOptions
58 ##
59 ## Revision 1.6 2002/12/06 04:49:10 jonen
60 ## + disabled output-puffer here
61 ##
62 ## Revision 1.5 2002/12/05 08:06:05 joko
63 ## + bugfix with determining empty fields (Null) with DBD::CSV
64 ## + debugging
65 ## + updated comments
66 ##
67 ## Revision 1.4 2002/12/03 15:54:07 joko
68 ## + {import}-flag is now {prepare}-flag
69 ##
70 ## Revision 1.3 2002/12/01 22:26:59 joko
71 ## + minor cosmetics for logging
72 ##
73 ## Revision 1.2 2002/12/01 04:43:25 joko
74 ## + mapping detail entries may now be either an ARRAY or a HASH
75 ## + erase flag is used now (for export-operations)
76 ## + expressions to refer to values inside deep nested structures
77 ## - removed old mappingV2-code
78 ## + cosmetics
79 ## + sub _erase_all
80 ##
81 ## Revision 1.1 2002/11/29 04:45:50 joko
82 ## + initial check in
83 ##
84 ## Revision 1.1 2002/10/10 03:44:21 cvsjoko
85 ## + new
86 ## -------------------------------------------------------------------------
87
88
89 package Data::Transfer::Sync::Core;
90
91 use strict;
92 use warnings;
93
94 use mixin::with qw( Data::Transfer::Sync );
95
96
97 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - main
98
99 use Data::Dumper;
100
101 #use misc::HashExt;
102 use Hash::Serializer;
103 use Data::Mungle::Compare::Struct qw( getDifference isEmpty );
104 use Data::Storage::Container;
105 use DesignPattern::Object;
106 use shortcuts::database qw( quotesql );
107
108 # get logger instance
109 my $logger = Log::Dispatch::Config->instance;
110
111 $| = 1;
112
113 =pod
114 sub new {
115 my $invocant = shift;
116 my $class = ref($invocant) || $invocant;
117 my $self = {};
118 $logger->debug( __PACKAGE__ . "->new(@_)" );
119 bless $self, $class;
120 $self->configure(@_);
121 return $self;
122 }
123 =cut
124
125
126 sub _init {
127 my $self = shift;
128
129 # build new container if necessary
130 $self->{container} = Data::Storage::Container->new() if !$self->{container};
131
132 # add storages to container (optional)
133 foreach (keys %{$self->{storages}}) {
134 $self->{container}->addStorage($_, $self->{storages}->{$_});
135 }
136
137 # trace
138 #print Dumper($self);
139 #exit;
140
141 return 1;
142
143 }
144
145 sub _initV1 {
146 my $self = shift;
147 $logger->debug( __PACKAGE__ . "->_initV1" );
148 die("this should not be reached!");
149 # tag storages with id-authority and checksum-provider information
150 # TODO: better store tag inside metadata to hold bits together!
151 map { $self->{container}->{storage}->{$_}->{isIdentAuthority} = 1 } @{$self->{id_authorities}};
152 map { $self->{container}->{storage}->{$_}->{isChecksumAuthority} = 1; } @{$self->{checksum_authorities}};
153 map { $self->{container}->{storage}->{$_}->{isWriteProtected} = 1; } @{$self->{write_protected}};
154 }
155
156
157 # TODO: abstract the hardwired use of "source" and "target" in here somehow - hmmmm....... /(="ยง/%???
158 sub _run {
159
160 my $self = shift;
161
162 #print "verbose: ", $self->{verbose}, "\n";
163 $self->{verbose} = 1;
164
165 $logger->debug( __PACKAGE__ . "->_run" );
166
167 # for statistics
168 my $tc = Hash::Serializer->new( {} );
169 my $results;
170
171 # set of objects is already in $self->{args}
172 # TODO: make independent of the terminology "object..."
173 $results = $self->{args}->{objectSet} if $self->{args}->{objectSet};
174
175 # apply filter
176 if (my $filter = $self->{meta}->{source}->{filter}) {
177 #print Dumper($filter);
178 #exit;
179 $results ||= $self->_getNodeList('source', $filter);
180 }
181
182 # get reference to node list from convenient method provided by CORE-HANDLE
183 $results ||= $self->_getNodeList('source');
184
185 #print Dumper($results);
186
187 # checkpoint: do we actually have a list to iterate through?
188 if (!$results || !@{$results}) {
189 $logger->notice( __PACKAGE__ . "->_run: No nodes to synchronize." );
190 return;
191 }
192
193
194
195 # check if we actually *have* a synchronization method
196 if (!$self->{options}->{metadata}->{syncMethod}) {
197 $logger->critical( __PACKAGE__ . "->_run: No synchronization method (checksum|timestamp) specified" );
198 return;
199 }
200
201
202 # dereference
203 my @results = @{$results};
204
205 # iterate through set
206 foreach my $source_node_real (@results) {
207
208 print ":" if $self->{verbose};
209
210 $tc->{total}++;
211
212 #print "======================== iter", "\n";
213
214 # clone object (in case we have to modify it here)
215 # TODO:
216 # - is a "deep_copy" needed here if occouring modifications take place?
217 # - puuhhhh, i guess a deep_copy would destroy tangram mechanisms?
218 # - after all, just take care for now that this object doesn't get updated!
219 # - so, just use its reference for now - if some cloning is needed in future, do this here!
220 my $source_node = $source_node_real;
221
222 # modify entry - handle new style callbacks (the readers)
223
224 # trace
225 #print Dumper($source_node);
226 #exit;
227
228 my $descent = 'source';
229
230 # handle callbacks right now while scanning them (asymmetric to the writers)
231 my $map_callbacks = {};
232 if (my $callbacks = $self->{meta}->{$descent}->{Callback}) {
233
234 # trace
235 #print Dumper($callbacks);
236 #exit;
237
238 my $error = 0;
239
240 foreach my $node (keys %{$callbacks->{read}}) {
241
242 my $object = $source_node;
243 my $value; # = $source_node->{$node};
244
245 # trace
246 #print Dumper($self->{options});
247
248 # ------------ half-redundant: make $self->callCallback($object, $value, $opts)
249 #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read';
250 my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read';
251 my $evalstring = 'return ' . $perl_callback . '( { object => $object, property => $node, value => $value, storage => $self->{meta}->{$descent}->{storage} } );';
252 #print $evalstring, "\n"; exit;
253 my $cb_result = eval($evalstring);
254 if ($@) {
255 $error = 1;
256 $logger->error( __PACKAGE__ . "->_run: $@" );
257 next;
258 }
259 # ------------ half-redundant: make $self->callCallback($object, $value, $opts)
260
261 $source_node->{$node} = $cb_result;
262
263 }
264
265 }
266
267 # trace
268 #print Dumper($source_node);
269
270 # exclude defined fields (simply delete from object)
271 map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}};
272
273 # here we accumulate information about the status of the current node (payload/row/object/item/entry)
274 $self->{node} = {};
275 $self->{node}->{source}->{payload} = $source_node;
276
277 # trace
278 #print Dumper($self->{node});
279 #exit;
280
281 # determine ident of entry
282 my $identOK = $self->_resolveNodeIdent('source');
283 #if (!$identOK && lc $self->{args}->{direction} ne 'import') {
284 if (!$identOK) {
285 #print Dumper($self->{meta}->{source});
286 $logger->critical( __PACKAGE__ . "->_run: No ident found in source node ( nodeName='$self->{meta}->{source}->{nodeName}', nodeType='$self->{meta}->{source}->{nodeType}') try to \"prepare\" this node first?" );
287 return;
288 }
289
290 #print "l" if $self->{verbose};
291 my $statOK = $self->_statloadNode('target', $self->{node}->{source}->{ident});
292
293 # mark node as new either if there's no ident or if stat/load failed
294 if (!$statOK) {
295 $self->{node}->{status}->{new} = 1;
296 print "n" if $self->{verbose};
297 }
298
299 #print "checksum", "\n";
300
301 #print Dumper($self);
302
303 # determine status of entry by synchronization method
304 if ( lc $self->{options}->{metadata}->{syncMethod} eq 'checksum' ) {
305 #if ( $statOK && (lc $self->{args}->{method} eq 'checksum') ) {
306 #if ( !$self->{node}->{status}->{new} && (lc $self->{args}->{method} eq 'checksum') ) {
307
308 # calculate checksum of source node
309 #$self->_calcChecksum('source');
310 if (!$self->_readChecksum('source')) {
311 $logger->warning( __PACKAGE__ . "->_run: Could not find \"source\" entry with ident=\"$self->{node}->{source}->{ident}\"" );
312 $tc->{skip}++;
313 print "s" if $self->{verbose};
314 next;
315 }
316
317 # get checksum from synchronization target
318 $self->_readChecksum('target');
319 #if (!$self->_readChecksum('target')) {
320 # $logger->critical( __PACKAGE__ . "->_readChecksum: Could not find \"target\" entry with ident=\"$self->{node}->{source}->{ident}\"" );
321 # next;
322 #}
323
324 # pre flight check: do we actually have a checksum provided?
325 #if (!$self->{node}->{source}->{checksum}) {
326 # print "Source checksum for entry with ident \"$self->{node}->{source}->{ident}\" could not be calculated, maybe it's missing?.", "\n";
327 # return;
328 #}
329
330 # determine if entry is "new" or "dirty"
331 # after all, this seems to be the point where the hammer falls.....
332 print "c" if $self->{verbose};
333
334 # trace
335 #print Dumper($self->{node});
336 #exit;
337
338 $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum};
339 if (!$self->{node}->{status}->{new}) {
340 $self->{node}->{status}->{dirty} =
341 $self->{node}->{status}->{new} ||
342 (!$self->{node}->{source}->{checksum} || !$self->{node}->{target}->{checksum}) ||
343 ($self->{node}->{source}->{checksum} ne $self->{node}->{target}->{checksum}) ||
344 $self->{args}->{force};
345 }
346
347 } else {
348 $logger->warning( __PACKAGE__ . "->_run: Synchronization method '$self->{options}->{metadata}->{syncMethod}' is not implemented" );
349 $tc->{skip}++;
350 print "s" if $self->{verbose};
351 next;
352 }
353
354 # first reaction on entry-status: continue with next entry if the current is already "in sync"
355 if (!$self->{node}->{status}->{new} && !$self->{node}->{status}->{dirty}) {
356 $tc->{in_sync}++;
357 next;
358 }
359
360 # build map to actually transfer the data from source to target
361 if (!$self->buildAttributeMap()) {
362 #$logger->warning( __PACKAGE__ . "->_run: Attribute Map could not be created. Will not insert or modify node.");
363 $tc->{skip}++;
364 print "e" if $self->{verbose};
365 next;
366 }
367
368 # trace
369 #print Dumper($self->{node}); exit;
370 #print "attempt", "\n";
371
372 # additional (new) checks for feature "write-protection"
373 if ($self->{meta}->{target}->{storage}->{isWriteProtected}) {
374 $tc->{attempt_transfer}++;
375 print "\n" if $self->{verbose};
376 $logger->notice( __PACKAGE__ . "->_run: Target is write-protected. Will not insert or modify node. " .
377 "(Ident: $self->{node}->{source}->{ident} " . "Dump:\n" . Dumper($self->{node}->{source}->{payload}) . ")" );
378 print "\n" if $self->{verbose};
379 $tc->{skip}++;
380 next;
381 }
382
383 # trace
384 #print Dumper($self);
385 #exit;
386
387 # transfer contents of map to target
388 if ($self->{node}->{status}->{new}) {
389 $tc->{attempt_new}++;
390 $self->_doTransferToTarget('insert');
391 # asymmetry: refetch node from target to re-calculate new ident and checksum (TODO: is IdentAuthority of relevance here?)
392 #print Dumper($self->{node});
393 $self->_statloadNode('target', $self->{node}->{target}->{ident}, 1);
394 $self->_readChecksum('target');
395
396 } elsif ($self->{node}->{status}->{dirty}) {
397 $tc->{attempt_modify}++;
398 # asymmetry: get ident before updating (TODO: is IdentAuthority of relevance here?)
399 $self->{node}->{target}->{ident} = $self->{node}->{map}->{$self->{meta}->{target}->{IdentProvider}->{arg}};
400 $self->_doTransferToTarget('update');
401 $self->_readChecksum('target');
402 }
403
404 if ($self->{node}->{status}->{ok}) {
405 $tc->{ok}++;
406 print "t" if $self->{verbose};
407 }
408
409 if ($self->{node}->{status}->{error}) {
410 $tc->{error}++;
411 push( @{$tc->{error_per_row}}, $self->{node}->{status}->{error} );
412 print "e" if $self->{verbose};
413 }
414
415 # trace
416 #print Dumper($self);
417 #exit;
418
419 # change ident in source (take from target), if transfer was ok and target is an IdentAuthority
420 # this is (for now) called a "retransmit" indicated by a "r"-character when verbosing
421 #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) {
422 if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) {
423 print "r" if $self->{verbose};
424 #print Dumper($self->{meta});
425 #print Dumper($self->{node});
426 #exit;
427 $self->_doModifySource_IdentChecksum($self->{node}->{target}->{ident});
428 }
429
430 }
431
432 print "\n" if $self->{verbose};
433
434 # build user-message from some stats
435 my $msg = "statistics: $tc";
436
437 if ($tc->{error_per_row}) {
438 $msg .= "\n";
439 $msg .= "errors from \"error_per_row\":" . "\n";
440 $msg .= Dumper($tc->{error_per_row});
441 }
442
443 # todo!!!
444 #sysevent( { usermsg => $msg, level => $level }, $taskEvent );
445 #$logger->info( __PACKAGE__ . "->_run: $msg" );
446 $logger->info($msg . "\n");
447
448 return $tc;
449
450 }
451
452
453 # refactor this as some core-function to do a generic dump resolving data-encapsulations of e.g. Set::Object
454 sub _dumpCompact {
455 my $self = shift;
456
457 #my $vars = \@_;
458 my @data = ();
459
460 my $count = 0;
461 foreach (@_) {
462 my $item = {};
463 foreach my $key (keys %$_) {
464 my $val = $_->{$key};
465
466 #print Dumper($val);
467
468 if (ref $val eq 'Set::Object') {
469 #print "========================= SET", "\n";
470 #print Dumper($val);
471 #print Dumper($val->members());
472 #$val = $val->members();
473 #$vars->[$count]->{$key} = $val->members() if $val->can("members");
474 #$item->{$key} = $val->members() if $val->can("members");
475 $item->{$key} = $val->members();
476 #print Dumper($vars->[$count]->{$key});
477
478 } else {
479 $item->{$key} = $val;
480 }
481
482 }
483 push @data, $item;
484 $count++;
485 }
486
487 #print "Dump:", Dumper(@data), "\n";
488
489 $Data::Dumper::Indent = 0;
490 my $result = Dumper(@data);
491 $Data::Dumper::Indent = 2;
492 return $result;
493
494 }
495
496
497
498 sub _doTransferToTarget {
499 my $self = shift;
500 my $action = shift;
501
502 # trace
503 #print Dumper($self->{meta});
504 #print Dumper($self->{node});
505 #exit;
506
507 $self->_modifyNode('target', $action, $self->{node}->{map});
508 }
509
510
511 sub _doModifySource_IdentChecksum {
512 my $self = shift;
513 my $ident_new = shift;
514 # this changes an old node to a new one including ident and checksum
515 # TODO:
516 # - eventually introduce an external resource to store this data to
517 # - we won't have to "re"-modify the source node here
518 my $map = {
519 $self->{meta}->{source}->{IdentProvider}->{arg} => $ident_new,
520 cs => $self->{node}->{target}->{checksum},
521 };
522
523 #print Dumper($map);
524 #print Dumper($self->{node});
525 #exit;
526
527 $self->_modifyNode('source', 'update', $map);
528 }
529
530
531
532 sub _prepareNode_MetaProperties {
533 my $self = shift;
534 my $descent = shift;
535
536 $logger->info( __PACKAGE__ . "->_prepareNode_MetaProperties( descent $descent )" );
537
538 # TODO: this should (better) be: "my $firstnode = $self->_getFirstNode($descent);"
539 my $list = $self->_getNodeList($descent);
540
541 # get first node
542 my $firstnode = $list->[0];
543
544 # check if node contains meta properties/nodes
545 # TODO: "cs" is hardcoded here!
546 my @required = ( $self->{meta}->{$descent}->{IdentProvider}->{arg}, 'cs' );
547 my @found = keys %$firstnode;
548 #my @diff = getDifference(\@found, \@required);
549 my $diff = getDifference(\@required, \@found);
550 #print Dumper(@found);
551 #print Dumper(@required);
552 #print Dumper(@diff);
553 #if (!$#diff || $#diff == -1) {
554 if (isEmpty($diff)) {
555 $logger->warning( __PACKAGE__ . "->_prepareNode_MetaProperties: node is lacking meta properties - will try to alter..." );
556 foreach (@required) {
557 my $sql = "ALTER TABLE $self->{meta}->{$descent}->{node} ADD COLUMN $_";
558 #print "sql: $sql", "\n";
559 my $res = $self->{meta}->{$descent}->{storage}->sendCommand($sql);
560 #print Dumper($res->getStatus());
561 }
562 }
563
564 }
565
566 sub _prepareNode_DummyIdent {
567 my $self = shift;
568 my $descent = shift;
569
570 $logger->info( __PACKAGE__ . "->_prepareNode_DummyIdent( descent $descent )" );
571
572 my $list = $self->_getNodeList($descent);
573 #print Dumper($list);
574 my $i = 0;
575 my $ident_base = 5678983;
576 my $ident_appendix = '0001';
577 foreach my $node (@$list) {
578 my $ident_dummy = $i + $ident_base;
579 $ident_dummy .= $ident_appendix;
580 my $map = {
581 $self->{meta}->{$descent}->{IdentProvider}->{arg} => $ident_dummy,
582 cs => undef,
583 };
584
585 # diff lists and ...
586 my $diff = getDifference([keys %$node], [keys %$map]);
587 next if $#{$diff} == -1;
588
589 # ... build criteria including all columns
590 my @crits;
591 foreach my $property (@$diff) {
592 next if !$property;
593 my $value = $node->{$property};
594 next if !$value;
595 push @crits, "$property='" . quotesql($value) . "'";
596 }
597 my $crit = join ' AND ', @crits;
598 print "p" if $self->{verbose};
599
600 #print Dumper($map);
601 #print Dumper($crit);
602
603 $self->_modifyNode($descent, 'update', $map, $crit);
604 $i++;
605 }
606
607 #print "\n" if $self->{verbose};
608
609 if (!$i) {
610 $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" );
611 }
612
613 }
614
615 # TODO: handle this in an abstract way (wipe out use of 'source' and/or 'target' inside core)
616 sub _otherSide {
617 my $self = shift;
618 my $descent = shift;
619 return 'source' if $descent eq 'target';
620 return 'target' if $descent eq 'source';
621 return '';
622 }
623
624
625 1;
626 __END__

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