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 |
## Revision 1.5 2003/02/11 05:30:47 joko |
21 |
## + minor fixes and some debugging mud |
## + minor fixes and some debugging mud |
22 |
## |
## |
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 ); |
use libdb qw( quotesql ); |
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} |
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 |
|
|
235 |
my $object = $source_node; |
my $object = $source_node; |
236 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
237 |
|
|
238 |
#print Dumper($self->{options}); |
# 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'; |
245 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
246 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
247 |
if ($@) { |
if ($@) { |
|
#die $@; |
|
|
$logger->error( __PACKAGE__ . "->_run: $@" ); |
|
248 |
$error = 1; |
$error = 1; |
249 |
#print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_run: $@" ); |
250 |
return; |
next; |
251 |
} |
} |
252 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
253 |
|
|
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 |
|
|
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__ |