6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
9 |
|
## Revision 1.6 2003/02/14 14:03:49 joko |
10 |
|
## + logging, debugging |
11 |
|
## - refactored code to sister module |
12 |
|
## |
13 |
## Revision 1.5 2003/02/11 05:30:47 joko |
## Revision 1.5 2003/02/11 05:30:47 joko |
14 |
## + minor fixes and some debugging mud |
## + minor fixes and some debugging mud |
15 |
## |
## |
205 |
my $source_node = $source_node_real; |
my $source_node = $source_node_real; |
206 |
|
|
207 |
# modify entry - handle new style callbacks (the readers) |
# modify entry - handle new style callbacks (the readers) |
208 |
#print Dumper($source_node); |
|
209 |
#exit; |
# trace |
210 |
|
#print Dumper($source_node); |
211 |
|
#exit; |
212 |
|
|
213 |
my $descent = 'source'; |
my $descent = 'source'; |
214 |
|
|
227 |
my $object = $source_node; |
my $object = $source_node; |
228 |
my $value; # = $source_node->{$node}; |
my $value; # = $source_node->{$node}; |
229 |
|
|
230 |
#print Dumper($self->{options}); |
# trace |
231 |
|
#print Dumper($self->{options}); |
232 |
|
|
233 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
234 |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
#my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; |
237 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
238 |
my $cb_result = eval($evalstring); |
my $cb_result = eval($evalstring); |
239 |
if ($@) { |
if ($@) { |
|
#die $@; |
|
|
$logger->error( __PACKAGE__ . "->_run: $@" ); |
|
240 |
$error = 1; |
$error = 1; |
241 |
#print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_run: $@" ); |
242 |
return; |
next; |
243 |
} |
} |
244 |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
245 |
|
|
602 |
return ''; |
return ''; |
603 |
} |
} |
604 |
|
|
|
sub _erase_all { |
|
|
my $self = shift; |
|
|
my $descent = shift; |
|
|
#my $node = shift; |
|
|
my $node = $self->{meta}->{$descent}->{node}; |
|
|
$self->{meta}->{$descent}->{storage}->eraseAll($node); |
|
|
} |
|
605 |
|
|
606 |
1; |
1; |
607 |
|
__END__ |