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 |
## Revision 1.5 2003/02/11 05:30:47 joko |
18 |
## + minor fixes and some debugging mud |
## + minor fixes and some debugging mud |
19 |
## |
## |
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; |
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} |
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 |
|
|
232 |
my $object = $source_node; |
my $object = $source_node; |
233 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
234 |
|
|
235 |
#print Dumper($self->{options}); |
# 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'; |
242 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
243 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
244 |
if ($@) { |
if ($@) { |
|
#die $@; |
|
|
$logger->error( __PACKAGE__ . "->_run: $@" ); |
|
245 |
$error = 1; |
$error = 1; |
246 |
#print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_run: $@" ); |
247 |
return; |
next; |
248 |
} |
} |
249 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
250 |
|
|
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 |
|
|
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__ |