6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
9 |
|
## Revision 1.4 2003/02/14 14:14:38 joko |
10 |
|
## + new code refactored here |
11 |
|
## |
12 |
|
## Revision 1.3 2003/02/11 07:54:55 joko |
13 |
|
## + modified module usage |
14 |
|
## + debugging trials |
15 |
|
## |
16 |
## Revision 1.2 2003/02/09 05:05:58 joko |
## Revision 1.2 2003/02/09 05:05:58 joko |
17 |
## + major structure changes |
## + major structure changes |
18 |
## - refactored code to sister modules |
## - refactored code to sister modules |
39 |
|
|
40 |
use Data::Dumper; |
use Data::Dumper; |
41 |
use Hash::Merge qw( merge ); |
use Hash::Merge qw( merge ); |
42 |
use libdb qw( quotesql hash2Sql ); |
use libdb qw( hash2Sql ); |
43 |
use Data::Transform::Deep qw( hash2object refexpr2perlref ); |
use Data::Transform::Deep qw( hash2object ); |
44 |
|
|
45 |
|
|
46 |
# get logger instance |
# get logger instance |
64 |
my $self = shift; |
my $self = shift; |
65 |
my $descent = shift; |
my $descent = shift; |
66 |
|
|
67 |
#print Dumper($self->{node}->{$descent}); |
# trace |
68 |
#print Dumper($self); |
#print Dumper($self->{node}->{$descent}); |
69 |
|
#print Dumper($self); |
70 |
|
#exit; |
71 |
|
|
72 |
$logger->debug( __PACKAGE__ . "->_resolveNodeIdent( descent=$descent, accessorName=$self->{meta}->{$descent}->{accessorName} )" ); |
$logger->debug( __PACKAGE__ . "->_resolveNodeIdent( descent=$descent, accessorName=$self->{meta}->{$descent}->{accessorName} )" ); |
73 |
|
|
74 |
# get to the payload |
# get to the payload |
80 |
#my $ident = $self->{$descent}->id($item); |
#my $ident = $self->{$descent}->id($item); |
81 |
#my $ident = $self->{meta}->{$descent}->{storage}->id($item); |
#my $ident = $self->{meta}->{$descent}->{storage}->id($item); |
82 |
|
|
83 |
|
# trace |
84 |
|
#print Dumper($self->{meta}->{$descent}); |
85 |
|
#exit; |
86 |
|
|
87 |
my $ident; |
my $ident; |
88 |
my $provider_method = $self->{meta}->{$descent}->{IdentProvider}->{method}; |
my $provider_method = $self->{meta}->{$descent}->{IdentProvider}->{method}; |
89 |
my $provider_arg = $self->{meta}->{$descent}->{IdentProvider}->{arg}; |
my $provider_arg = $self->{meta}->{$descent}->{IdentProvider}->{arg}; |
130 |
my $ident = shift; |
my $ident = shift; |
131 |
my $force = shift; |
my $force = shift; |
132 |
|
|
133 |
$logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); |
#$logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); |
134 |
|
|
135 |
# fetch entry to retrieve checksum from |
# fetch entry to retrieve checksum from |
136 |
# was: |
# was: |
502 |
#print Dumper($map_callbacks); |
#print Dumper($map_callbacks); |
503 |
foreach my $node (keys %{$map_callbacks->{write}}) { |
foreach my $node (keys %{$map_callbacks->{write}}) { |
504 |
#print Dumper($node); |
#print Dumper($node); |
505 |
my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_write'; |
|
506 |
|
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
507 |
|
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_write'; |
508 |
my $evalstring = $perl_callback . '( { object => $object, value => $map_callbacks->{write}->{$node}, storage => $self->{meta}->{$descent}->{storage} } );'; |
my $evalstring = $perl_callback . '( { object => $object, value => $map_callbacks->{write}->{$node}, storage => $self->{meta}->{$descent}->{storage} } );'; |
509 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
510 |
eval($evalstring); |
eval($evalstring); |
511 |
if ($@) { |
if ($@) { |
512 |
$error = 1; |
$error = 1; |
513 |
print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_modifyNode: $@" ); |
514 |
|
next; |
515 |
} |
} |
516 |
|
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
517 |
|
|
518 |
#print "after eval", "\n"; |
#print "after eval", "\n"; |
519 |
|
|
548 |
|
|
549 |
} |
} |
550 |
|
|
551 |
|
sub _erase_all { |
552 |
|
my $self = shift; |
553 |
|
my $descent = shift; |
554 |
|
#my $node = shift; |
555 |
|
#print Dumper($self->{meta}->{$descent}); |
556 |
|
#my $node = $self->{meta}->{$descent}->{nodeName}; |
557 |
|
my $node = $self->{meta}->{$descent}->{accessorName}; |
558 |
|
$logger->debug( __PACKAGE__ . "->_erase_all( node $node )" ); |
559 |
|
$self->{meta}->{$descent}->{storage}->eraseAll($node); |
560 |
|
} |
561 |
|
|
562 |
1; |
1; |
563 |
|
__END__ |