6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
9 |
|
## Revision 1.8 2003/03/27 15:31:15 joko |
10 |
|
## fixes to modules regarding new namespace(s) below Data::Mungle::* |
11 |
|
## |
12 |
|
## Revision 1.7 2003/02/21 08:01:11 joko |
13 |
|
## debugging, logging |
14 |
|
## renamed module |
15 |
|
## |
16 |
|
## Revision 1.6 2003/02/14 14:03:49 joko |
17 |
|
## + logging, debugging |
18 |
|
## - refactored code to sister module |
19 |
|
## |
20 |
|
## Revision 1.5 2003/02/11 05:30:47 joko |
21 |
|
## + minor fixes and some debugging mud |
22 |
|
## |
23 |
## Revision 1.4 2003/02/09 05:01:10 joko |
## Revision 1.4 2003/02/09 05:01:10 joko |
24 |
## + major structure changes |
## + major structure changes |
25 |
## - refactored code to sister modules |
## - refactored code to sister modules |
93 |
|
|
94 |
use Data::Dumper; |
use Data::Dumper; |
95 |
|
|
96 |
use misc::HashExt; |
#use misc::HashExt; |
97 |
use Data::Compare::Struct qw( getDifference isEmpty ); |
use Hash::Serializer; |
98 |
|
use Data::Mungle::Compare::Struct qw( getDifference isEmpty ); |
99 |
use Data::Storage::Container; |
use Data::Storage::Container; |
100 |
use DesignPattern::Object; |
use DesignPattern::Object; |
101 |
|
use libdb qw( quotesql ); |
102 |
|
|
103 |
# get logger instance |
# get logger instance |
104 |
my $logger = Log::Dispatch::Config->instance; |
my $logger = Log::Dispatch::Config->instance; |
129 |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
130 |
} |
} |
131 |
|
|
132 |
|
# trace |
133 |
|
#print Dumper($self); |
134 |
|
#exit; |
135 |
|
|
136 |
return 1; |
return 1; |
137 |
|
|
138 |
} |
} |
160 |
$logger->debug( __PACKAGE__ . "->_run" ); |
$logger->debug( __PACKAGE__ . "->_run" ); |
161 |
|
|
162 |
# for statistics |
# for statistics |
163 |
my $tc = OneLineDumpHash->new( {} ); |
my $tc = Hash::Serializer->new( {} ); |
164 |
my $results; |
my $results; |
165 |
|
|
166 |
# set of objects is already in $self->{args} |
# set of objects is already in $self->{args} |
198 |
# iterate through set |
# iterate through set |
199 |
foreach my $source_node_real (@results) { |
foreach my $source_node_real (@results) { |
200 |
|
|
201 |
|
print ":" if $self->{verbose}; |
202 |
|
|
203 |
$tc->{total}++; |
$tc->{total}++; |
204 |
|
|
205 |
#print "======================== iter", "\n"; |
#print "======================== iter", "\n"; |
209 |
# - is a "deep_copy" needed here if occouring modifications take place? |
# - is a "deep_copy" needed here if occouring modifications take place? |
210 |
# - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? |
# - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? |
211 |
# - after all, just take care for now that this object doesn't get updated! |
# - after all, just take care for now that this object doesn't get updated! |
212 |
|
# - so, just use its reference for now - if some cloning is needed in future, do this here! |
213 |
my $source_node = $source_node_real; |
my $source_node = $source_node_real; |
214 |
|
|
215 |
# modify entry - handle new style callbacks (the readers) |
# modify entry - handle new style callbacks (the readers) |
216 |
#print Dumper($source_node); |
|
217 |
#exit; |
# trace |
218 |
|
#print Dumper($source_node); |
219 |
|
#exit; |
220 |
|
|
221 |
my $descent = 'source'; |
my $descent = 'source'; |
222 |
|
|
224 |
my $map_callbacks = {}; |
my $map_callbacks = {}; |
225 |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
226 |
|
|
227 |
|
# trace |
228 |
|
#print Dumper($callbacks); |
229 |
|
#exit; |
230 |
|
|
231 |
my $error = 0; |
my $error = 0; |
232 |
|
|
233 |
foreach my $node (keys %{$callbacks->{read}}) { |
foreach my $node (keys %{$callbacks->{read}}) { |
235 |
my $object = $source_node; |
my $object = $source_node; |
236 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
237 |
|
|
238 |
|
# trace |
239 |
|
#print Dumper($self->{options}); |
240 |
|
|
241 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
242 |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
243 |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
245 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
246 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
247 |
if ($@) { |
if ($@) { |
|
die $@; |
|
248 |
$error = 1; |
$error = 1; |
249 |
print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_run: $@" ); |
250 |
|
next; |
251 |
} |
} |
252 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
253 |
|
|
257 |
|
|
258 |
} |
} |
259 |
|
|
260 |
#print Dumper($source_node); |
# trace |
261 |
|
#print Dumper($source_node); |
262 |
|
|
263 |
# exclude defined fields (simply delete from object) |
# exclude defined fields (simply delete from object) |
264 |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
267 |
$self->{node} = {}; |
$self->{node} = {}; |
268 |
$self->{node}->{source}->{payload} = $source_node; |
$self->{node}->{source}->{payload} = $source_node; |
269 |
|
|
270 |
#print "res - ident", "\n"; |
# trace |
271 |
|
#print Dumper($self->{node}); |
272 |
|
#exit; |
273 |
|
|
274 |
# determine ident of entry |
# determine ident of entry |
275 |
my $identOK = $self->_resolveNodeIdent('source'); |
my $identOK = $self->_resolveNodeIdent('source'); |
291 |
|
|
292 |
#print "checksum", "\n"; |
#print "checksum", "\n"; |
293 |
|
|
|
print ":" if $self->{verbose}; |
|
|
|
|
294 |
#print Dumper($self); |
#print Dumper($self); |
295 |
|
|
296 |
# determine status of entry by synchronization method |
# determine status of entry by synchronization method |
323 |
# determine if entry is "new" or "dirty" |
# determine if entry is "new" or "dirty" |
324 |
# after all, this seems to be the point where the hammer falls..... |
# after all, this seems to be the point where the hammer falls..... |
325 |
print "c" if $self->{verbose}; |
print "c" if $self->{verbose}; |
326 |
#print Dumper($self->{node}); |
|
327 |
#exit; |
# trace |
328 |
|
#print Dumper($self->{node}); |
329 |
|
#exit; |
330 |
|
|
331 |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
332 |
if (!$self->{node}->{status}->{new}) { |
if (!$self->{node}->{status}->{new}) { |
333 |
$self->{node}->{status}->{dirty} = |
$self->{node}->{status}->{dirty} = |
355 |
$self->buildAttributeMap(); |
$self->buildAttributeMap(); |
356 |
|
|
357 |
|
|
358 |
#print Dumper($self->{node}); exit; |
# trace |
359 |
|
#print Dumper($self->{node}); exit; |
360 |
#print "attempt", "\n"; |
#print "attempt", "\n"; |
361 |
|
|
362 |
# additional (new) checks for feature "write-protection" |
# additional (new) checks for feature "write-protection" |
363 |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
370 |
next; |
next; |
371 |
} |
} |
372 |
|
|
373 |
#print Dumper($self); |
# trace |
374 |
#exit; |
#print Dumper($self); |
375 |
|
#exit; |
376 |
|
|
377 |
# transfer contents of map to target |
# transfer contents of map to target |
378 |
if ($self->{node}->{status}->{new}) { |
if ($self->{node}->{status}->{new}) { |
408 |
|
|
409 |
# change ident in source (take from target), if transfer was ok and target is an IdentAuthority |
# change ident in source (take from target), if transfer was ok and target is an IdentAuthority |
410 |
# this is (for now) called a "retransmit" indicated by a "r"-character when verbosing |
# this is (for now) called a "retransmit" indicated by a "r"-character when verbosing |
411 |
if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
#if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
412 |
|
if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) { |
413 |
print "r" if $self->{verbose}; |
print "r" if $self->{verbose}; |
414 |
#print Dumper($self->{meta}); |
#print Dumper($self->{meta}); |
415 |
#print Dumper($self->{node}); |
#print Dumper($self->{node}); |
432 |
|
|
433 |
# todo!!! |
# todo!!! |
434 |
#sysevent( { usermsg => $msg, level => $level }, $taskEvent ); |
#sysevent( { usermsg => $msg, level => $level }, $taskEvent ); |
435 |
$logger->info( __PACKAGE__ . "->_run: $msg" ); |
#$logger->info( __PACKAGE__ . "->_run: $msg" ); |
436 |
|
$logger->info($msg . "\n"); |
437 |
|
|
438 |
return $tc; |
return $tc; |
439 |
|
|
488 |
sub _doTransferToTarget { |
sub _doTransferToTarget { |
489 |
my $self = shift; |
my $self = shift; |
490 |
my $action = shift; |
my $action = shift; |
491 |
#print Dumper($self->{node}); |
|
492 |
#exit; |
# trace |
493 |
|
#print Dumper($self->{meta}); |
494 |
|
#print Dumper($self->{node}); |
495 |
|
#exit; |
496 |
|
|
497 |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
498 |
} |
} |
499 |
|
|
594 |
$i++; |
$i++; |
595 |
} |
} |
596 |
|
|
597 |
print "\n" if $self->{verbose}; |
#print "\n" if $self->{verbose}; |
598 |
|
|
599 |
if (!$i) { |
if (!$i) { |
600 |
$logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" ); |
$logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" ); |
611 |
return ''; |
return ''; |
612 |
} |
} |
613 |
|
|
|
sub _erase_all { |
|
|
my $self = shift; |
|
|
my $descent = shift; |
|
|
#my $node = shift; |
|
|
my $node = $self->{meta}->{$descent}->{node}; |
|
|
$self->{meta}->{$descent}->{storage}->eraseAll($node); |
|
|
} |
|
614 |
|
|
615 |
1; |
1; |
616 |
|
__END__ |