6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
9 |
|
## Revision 1.7 2003/02/21 08:01:11 joko |
10 |
|
## debugging, logging |
11 |
|
## renamed module |
12 |
|
## |
13 |
|
## Revision 1.6 2003/02/14 14:03:49 joko |
14 |
|
## + logging, debugging |
15 |
|
## - refactored code to sister module |
16 |
|
## |
17 |
|
## Revision 1.5 2003/02/11 05:30:47 joko |
18 |
|
## + minor fixes and some debugging mud |
19 |
|
## |
20 |
## Revision 1.4 2003/02/09 05:01:10 joko |
## Revision 1.4 2003/02/09 05:01:10 joko |
21 |
## + major structure changes |
## + major structure changes |
22 |
## - refactored code to sister modules |
## - refactored code to sister modules |
90 |
|
|
91 |
use Data::Dumper; |
use Data::Dumper; |
92 |
|
|
93 |
use misc::HashExt; |
#use misc::HashExt; |
94 |
|
use Hash::Serializer; |
95 |
use Data::Compare::Struct qw( getDifference isEmpty ); |
use Data::Compare::Struct qw( getDifference isEmpty ); |
96 |
use Data::Storage::Container; |
use Data::Storage::Container; |
97 |
use DesignPattern::Object; |
use DesignPattern::Object; |
98 |
|
use libdb qw( quotesql ); |
99 |
|
|
100 |
# get logger instance |
# get logger instance |
101 |
my $logger = Log::Dispatch::Config->instance; |
my $logger = Log::Dispatch::Config->instance; |
126 |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
127 |
} |
} |
128 |
|
|
129 |
|
# trace |
130 |
|
#print Dumper($self); |
131 |
|
#exit; |
132 |
|
|
133 |
return 1; |
return 1; |
134 |
|
|
135 |
} |
} |
157 |
$logger->debug( __PACKAGE__ . "->_run" ); |
$logger->debug( __PACKAGE__ . "->_run" ); |
158 |
|
|
159 |
# for statistics |
# for statistics |
160 |
my $tc = OneLineDumpHash->new( {} ); |
my $tc = Hash::Serializer->new( {} ); |
161 |
my $results; |
my $results; |
162 |
|
|
163 |
# set of objects is already in $self->{args} |
# set of objects is already in $self->{args} |
195 |
# iterate through set |
# iterate through set |
196 |
foreach my $source_node_real (@results) { |
foreach my $source_node_real (@results) { |
197 |
|
|
198 |
|
print ":" if $self->{verbose}; |
199 |
|
|
200 |
$tc->{total}++; |
$tc->{total}++; |
201 |
|
|
202 |
#print "======================== iter", "\n"; |
#print "======================== iter", "\n"; |
206 |
# - is a "deep_copy" needed here if occouring modifications take place? |
# - is a "deep_copy" needed here if occouring modifications take place? |
207 |
# - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? |
# - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? |
208 |
# - 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! |
209 |
|
# - so, just use its reference for now - if some cloning is needed in future, do this here! |
210 |
my $source_node = $source_node_real; |
my $source_node = $source_node_real; |
211 |
|
|
212 |
# modify entry - handle new style callbacks (the readers) |
# modify entry - handle new style callbacks (the readers) |
213 |
#print Dumper($source_node); |
|
214 |
#exit; |
# trace |
215 |
|
#print Dumper($source_node); |
216 |
|
#exit; |
217 |
|
|
218 |
my $descent = 'source'; |
my $descent = 'source'; |
219 |
|
|
221 |
my $map_callbacks = {}; |
my $map_callbacks = {}; |
222 |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
223 |
|
|
224 |
|
# trace |
225 |
|
#print Dumper($callbacks); |
226 |
|
#exit; |
227 |
|
|
228 |
my $error = 0; |
my $error = 0; |
229 |
|
|
230 |
foreach my $node (keys %{$callbacks->{read}}) { |
foreach my $node (keys %{$callbacks->{read}}) { |
232 |
my $object = $source_node; |
my $object = $source_node; |
233 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
234 |
|
|
235 |
|
# trace |
236 |
|
#print Dumper($self->{options}); |
237 |
|
|
238 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
239 |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
240 |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
242 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
243 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
244 |
if ($@) { |
if ($@) { |
|
die $@; |
|
245 |
$error = 1; |
$error = 1; |
246 |
print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_run: $@" ); |
247 |
|
next; |
248 |
} |
} |
249 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
250 |
|
|
254 |
|
|
255 |
} |
} |
256 |
|
|
257 |
#print Dumper($source_node); |
# trace |
258 |
|
#print Dumper($source_node); |
259 |
|
|
260 |
# exclude defined fields (simply delete from object) |
# exclude defined fields (simply delete from object) |
261 |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
264 |
$self->{node} = {}; |
$self->{node} = {}; |
265 |
$self->{node}->{source}->{payload} = $source_node; |
$self->{node}->{source}->{payload} = $source_node; |
266 |
|
|
267 |
#print "res - ident", "\n"; |
# trace |
268 |
|
#print Dumper($self->{node}); |
269 |
|
#exit; |
270 |
|
|
271 |
# determine ident of entry |
# determine ident of entry |
272 |
my $identOK = $self->_resolveNodeIdent('source'); |
my $identOK = $self->_resolveNodeIdent('source'); |
288 |
|
|
289 |
#print "checksum", "\n"; |
#print "checksum", "\n"; |
290 |
|
|
|
print ":" if $self->{verbose}; |
|
|
|
|
291 |
#print Dumper($self); |
#print Dumper($self); |
292 |
|
|
293 |
# determine status of entry by synchronization method |
# determine status of entry by synchronization method |
320 |
# determine if entry is "new" or "dirty" |
# determine if entry is "new" or "dirty" |
321 |
# after all, this seems to be the point where the hammer falls..... |
# after all, this seems to be the point where the hammer falls..... |
322 |
print "c" if $self->{verbose}; |
print "c" if $self->{verbose}; |
323 |
#print Dumper($self->{node}); |
|
324 |
#exit; |
# trace |
325 |
|
#print Dumper($self->{node}); |
326 |
|
#exit; |
327 |
|
|
328 |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
329 |
if (!$self->{node}->{status}->{new}) { |
if (!$self->{node}->{status}->{new}) { |
330 |
$self->{node}->{status}->{dirty} = |
$self->{node}->{status}->{dirty} = |
352 |
$self->buildAttributeMap(); |
$self->buildAttributeMap(); |
353 |
|
|
354 |
|
|
355 |
#print Dumper($self->{node}); exit; |
# trace |
356 |
|
#print Dumper($self->{node}); exit; |
357 |
#print "attempt", "\n"; |
#print "attempt", "\n"; |
358 |
|
|
359 |
# additional (new) checks for feature "write-protection" |
# additional (new) checks for feature "write-protection" |
360 |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
367 |
next; |
next; |
368 |
} |
} |
369 |
|
|
370 |
#print Dumper($self); |
# trace |
371 |
#exit; |
#print Dumper($self); |
372 |
|
#exit; |
373 |
|
|
374 |
# transfer contents of map to target |
# transfer contents of map to target |
375 |
if ($self->{node}->{status}->{new}) { |
if ($self->{node}->{status}->{new}) { |
405 |
|
|
406 |
# 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 |
407 |
# 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 |
408 |
if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
#if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
409 |
|
if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) { |
410 |
print "r" if $self->{verbose}; |
print "r" if $self->{verbose}; |
411 |
#print Dumper($self->{meta}); |
#print Dumper($self->{meta}); |
412 |
#print Dumper($self->{node}); |
#print Dumper($self->{node}); |
429 |
|
|
430 |
# todo!!! |
# todo!!! |
431 |
#sysevent( { usermsg => $msg, level => $level }, $taskEvent ); |
#sysevent( { usermsg => $msg, level => $level }, $taskEvent ); |
432 |
$logger->info( __PACKAGE__ . "->_run: $msg" ); |
#$logger->info( __PACKAGE__ . "->_run: $msg" ); |
433 |
|
$logger->info($msg . "\n"); |
434 |
|
|
435 |
return $tc; |
return $tc; |
436 |
|
|
485 |
sub _doTransferToTarget { |
sub _doTransferToTarget { |
486 |
my $self = shift; |
my $self = shift; |
487 |
my $action = shift; |
my $action = shift; |
488 |
#print Dumper($self->{node}); |
|
489 |
#exit; |
# trace |
490 |
|
#print Dumper($self->{meta}); |
491 |
|
#print Dumper($self->{node}); |
492 |
|
#exit; |
493 |
|
|
494 |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
495 |
} |
} |
496 |
|
|
591 |
$i++; |
$i++; |
592 |
} |
} |
593 |
|
|
594 |
print "\n" if $self->{verbose}; |
#print "\n" if $self->{verbose}; |
595 |
|
|
596 |
if (!$i) { |
if (!$i) { |
597 |
$logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" ); |
$logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" ); |
608 |
return ''; |
return ''; |
609 |
} |
} |
610 |
|
|
|
sub _erase_all { |
|
|
my $self = shift; |
|
|
my $descent = shift; |
|
|
#my $node = shift; |
|
|
my $node = $self->{meta}->{$descent}->{node}; |
|
|
$self->{meta}->{$descent}->{storage}->eraseAll($node); |
|
|
} |
|
611 |
|
|
612 |
1; |
1; |
613 |
|
__END__ |