6 |
## |
## |
7 |
## ---------------------------------------------------------------------------------------- |
## ---------------------------------------------------------------------------------------- |
8 |
## $Log$ |
## $Log$ |
9 |
|
## Revision 1.5 2003/02/20 20:24:33 joko |
10 |
|
## + additional pre-flight checks |
11 |
|
## |
12 |
|
## Revision 1.4 2003/02/14 14:14:38 joko |
13 |
|
## + new code refactored here |
14 |
|
## |
15 |
## Revision 1.3 2003/02/11 07:54:55 joko |
## Revision 1.3 2003/02/11 07:54:55 joko |
16 |
## + modified module usage |
## + modified module usage |
17 |
## + debugging trials |
## + debugging trials |
133 |
my $ident = shift; |
my $ident = shift; |
134 |
my $force = shift; |
my $force = shift; |
135 |
|
|
136 |
|
=pod |
137 |
|
#print "isa: ", UNIVERSAL::isa($self->{meta}->{$descent}->{storage}), "\n"; |
138 |
|
|
139 |
|
# this seems to be the first time we access this side, |
140 |
|
# so just check (again) for a valid storage handle |
141 |
|
if (! ref $self->{meta}->{$descent}->{storage}) { |
142 |
|
$logger->critical( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident ): Storage handle undefined!" ); |
143 |
|
return; |
144 |
|
} |
145 |
|
=cut |
146 |
|
|
147 |
#$logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); |
#$logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); |
148 |
|
|
149 |
# fetch entry to retrieve checksum from |
# fetch entry to retrieve checksum from |
251 |
next; |
next; |
252 |
} |
} |
253 |
|
|
254 |
|
# 2.b check storage handle type |
255 |
|
my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type}; |
256 |
|
if (!$dbType) { |
257 |
|
$logger->critical( __PACKAGE__ . "->touchNodeSet: Storage ( descent='$descent', dbKey='$dbkey' ) has no 'dbType' - configuration-error?" ); |
258 |
|
next; |
259 |
|
} |
260 |
|
|
261 |
# 3. check if descents (and nodes?) are actually available.... |
# 3. check if descents (and nodes?) are actually available.... |
262 |
# TODO: |
# TODO: |
263 |
# eventually pre-check mode of access-attempt (read/write) here to provide an "early-croak" if possible |
# eventually pre-check mode of access-attempt (read/write) here to provide an "early-croak" if possible |
266 |
# print Dumper($self->{meta}->{$descent}->{storage}->{locator}); |
# print Dumper($self->{meta}->{$descent}->{storage}->{locator}); |
267 |
|
|
268 |
|
|
|
my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type}; |
|
269 |
my $nodeName = $self->{meta}->{$descent}->{nodeName}; |
my $nodeName = $self->{meta}->{$descent}->{nodeName}; |
270 |
my $accessorType = $self->{meta}->{$descent}->{accessorType}; |
my $accessorType = $self->{meta}->{$descent}->{accessorType}; |
271 |
my $accessorName = $self->{meta}->{$descent}->{accessorName}; |
my $accessorName = $self->{meta}->{$descent}->{accessorName}; |
522 |
#print Dumper($map_callbacks); |
#print Dumper($map_callbacks); |
523 |
foreach my $node (keys %{$map_callbacks->{write}}) { |
foreach my $node (keys %{$map_callbacks->{write}}) { |
524 |
#print Dumper($node); |
#print Dumper($node); |
525 |
my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_write'; |
|
526 |
|
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
527 |
|
my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_write'; |
528 |
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} } );'; |
529 |
#print $evalstring, "\n"; exit; |
#print $evalstring, "\n"; exit; |
530 |
eval($evalstring); |
eval($evalstring); |
531 |
if ($@) { |
if ($@) { |
532 |
$error = 1; |
$error = 1; |
533 |
print $@, "\n"; |
$logger->error( __PACKAGE__ . "->_modifyNode: $@" ); |
534 |
|
next; |
535 |
} |
} |
536 |
|
# ------------ half-redundant: make $self->callCallback($object, $value, $opts) |
537 |
|
|
538 |
#print "after eval", "\n"; |
#print "after eval", "\n"; |
539 |
|
|
568 |
|
|
569 |
} |
} |
570 |
|
|
571 |
|
sub _erase_all { |
572 |
|
my $self = shift; |
573 |
|
my $descent = shift; |
574 |
|
#my $node = shift; |
575 |
|
#print Dumper($self->{meta}->{$descent}); |
576 |
|
#my $node = $self->{meta}->{$descent}->{nodeName}; |
577 |
|
my $node = $self->{meta}->{$descent}->{accessorName}; |
578 |
|
$logger->debug( __PACKAGE__ . "->_erase_all( node $node )" ); |
579 |
|
$self->{meta}->{$descent}->{storage}->eraseAll($node); |
580 |
|
} |
581 |
|
|
582 |
1; |
1; |
583 |
|
__END__ |