6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
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 |
## Revision 1.4 2003/02/09 05:01:10 joko |
13 |
## + major structure changes |
## + major structure changes |
14 |
## - refactored code to sister modules |
## - refactored code to sister modules |
86 |
use Data::Compare::Struct qw( getDifference isEmpty ); |
use Data::Compare::Struct qw( getDifference isEmpty ); |
87 |
use Data::Storage::Container; |
use Data::Storage::Container; |
88 |
use DesignPattern::Object; |
use DesignPattern::Object; |
89 |
|
use libdb qw( quotesql ); |
90 |
|
|
91 |
# get logger instance |
# get logger instance |
92 |
my $logger = Log::Dispatch::Config->instance; |
my $logger = Log::Dispatch::Config->instance; |
117 |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
$self->{container}->addStorage($_, $self->{storages}->{$_}); |
118 |
} |
} |
119 |
|
|
120 |
|
# trace |
121 |
|
#print Dumper($self); |
122 |
|
#exit; |
123 |
|
|
124 |
return 1; |
return 1; |
125 |
|
|
126 |
} |
} |
186 |
# iterate through set |
# iterate through set |
187 |
foreach my $source_node_real (@results) { |
foreach my $source_node_real (@results) { |
188 |
|
|
189 |
|
print ":" if $self->{verbose}; |
190 |
|
|
191 |
$tc->{total}++; |
$tc->{total}++; |
192 |
|
|
193 |
#print "======================== iter", "\n"; |
#print "======================== iter", "\n"; |
197 |
# - is a "deep_copy" needed here if occouring modifications take place? |
# - is a "deep_copy" needed here if occouring modifications take place? |
198 |
# - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? |
# - 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! |
# - 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; |
my $source_node = $source_node_real; |
202 |
|
|
203 |
# modify entry - handle new style callbacks (the readers) |
# modify entry - handle new style callbacks (the readers) |
210 |
my $map_callbacks = {}; |
my $map_callbacks = {}; |
211 |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { |
212 |
|
|
213 |
|
# trace |
214 |
|
#print Dumper($callbacks); |
215 |
|
#exit; |
216 |
|
|
217 |
my $error = 0; |
my $error = 0; |
218 |
|
|
219 |
foreach my $node (keys %{$callbacks->{read}}) { |
foreach my $node (keys %{$callbacks->{read}}) { |
221 |
my $object = $source_node; |
my $object = $source_node; |
222 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
223 |
|
|
224 |
|
#print Dumper($self->{options}); |
225 |
|
|
226 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
227 |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
228 |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; |
230 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
231 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
232 |
if ($@) { |
if ($@) { |
233 |
die $@; |
#die $@; |
234 |
|
$logger->error( __PACKAGE__ . "->_run: $@" ); |
235 |
$error = 1; |
$error = 1; |
236 |
print $@, "\n"; |
#print $@, "\n"; |
237 |
|
return; |
238 |
} |
} |
239 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
240 |
|
|
244 |
|
|
245 |
} |
} |
246 |
|
|
247 |
#print Dumper($source_node); |
# trace |
248 |
|
#print Dumper($source_node); |
249 |
|
|
250 |
# exclude defined fields (simply delete from object) |
# exclude defined fields (simply delete from object) |
251 |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; |
254 |
$self->{node} = {}; |
$self->{node} = {}; |
255 |
$self->{node}->{source}->{payload} = $source_node; |
$self->{node}->{source}->{payload} = $source_node; |
256 |
|
|
257 |
#print "res - ident", "\n"; |
# trace |
258 |
|
#print Dumper($self->{node}); |
259 |
|
#exit; |
260 |
|
|
261 |
# determine ident of entry |
# determine ident of entry |
262 |
my $identOK = $self->_resolveNodeIdent('source'); |
my $identOK = $self->_resolveNodeIdent('source'); |
278 |
|
|
279 |
#print "checksum", "\n"; |
#print "checksum", "\n"; |
280 |
|
|
|
print ":" if $self->{verbose}; |
|
|
|
|
281 |
#print Dumper($self); |
#print Dumper($self); |
282 |
|
|
283 |
# determine status of entry by synchronization method |
# determine status of entry by synchronization method |
310 |
# determine if entry is "new" or "dirty" |
# determine if entry is "new" or "dirty" |
311 |
# after all, this seems to be the point where the hammer falls..... |
# after all, this seems to be the point where the hammer falls..... |
312 |
print "c" if $self->{verbose}; |
print "c" if $self->{verbose}; |
313 |
#print Dumper($self->{node}); |
|
314 |
#exit; |
# trace |
315 |
|
#print Dumper($self->{node}); |
316 |
|
#exit; |
317 |
|
|
318 |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
$self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; |
319 |
if (!$self->{node}->{status}->{new}) { |
if (!$self->{node}->{status}->{new}) { |
320 |
$self->{node}->{status}->{dirty} = |
$self->{node}->{status}->{dirty} = |
342 |
$self->buildAttributeMap(); |
$self->buildAttributeMap(); |
343 |
|
|
344 |
|
|
345 |
#print Dumper($self->{node}); exit; |
# trace |
346 |
|
#print Dumper($self->{node}); exit; |
347 |
#print "attempt", "\n"; |
#print "attempt", "\n"; |
348 |
|
|
349 |
# additional (new) checks for feature "write-protection" |
# additional (new) checks for feature "write-protection" |
350 |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { |
357 |
next; |
next; |
358 |
} |
} |
359 |
|
|
360 |
#print Dumper($self); |
# trace |
361 |
#exit; |
#print Dumper($self); |
362 |
|
#exit; |
363 |
|
|
364 |
# transfer contents of map to target |
# transfer contents of map to target |
365 |
if ($self->{node}->{status}->{new}) { |
if ($self->{node}->{status}->{new}) { |
395 |
|
|
396 |
# 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 |
397 |
# 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 |
398 |
if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
#if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { |
399 |
|
if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) { |
400 |
print "r" if $self->{verbose}; |
print "r" if $self->{verbose}; |
401 |
#print Dumper($self->{meta}); |
#print Dumper($self->{meta}); |
402 |
#print Dumper($self->{node}); |
#print Dumper($self->{node}); |
474 |
sub _doTransferToTarget { |
sub _doTransferToTarget { |
475 |
my $self = shift; |
my $self = shift; |
476 |
my $action = shift; |
my $action = shift; |
477 |
#print Dumper($self->{node}); |
|
478 |
#exit; |
# trace |
479 |
|
#print Dumper($self->{meta}); |
480 |
|
#print Dumper($self->{node}); |
481 |
|
#exit; |
482 |
|
|
483 |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
$self->_modifyNode('target', $action, $self->{node}->{map}); |
484 |
} |
} |
485 |
|
|