/[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.6 - (show annotations)
Fri Feb 14 14:03:49 2003 UTC (21 years, 4 months ago) by joko
Branch: MAIN
Changes since 1.5: +13 -15 lines
+ logging, debugging
- refactored code to sister module

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

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