--- nfo/perl/libs/Data/Transfer/Sync/StorageInterface.pm 2003/02/11 07:54:55 1.3 +++ nfo/perl/libs/Data/Transfer/Sync/StorageInterface.pm 2003/02/21 01:47:53 1.6 @@ -1,4 +1,4 @@ -## $Id: StorageInterface.pm,v 1.3 2003/02/11 07:54:55 joko Exp $ +## $Id: StorageInterface.pm,v 1.6 2003/02/21 01:47:53 joko Exp $ ## ## Copyright (c) 2002 Andreas Motl ## @@ -6,6 +6,15 @@ ## ## ---------------------------------------------------------------------------------------- ## $Log: StorageInterface.pm,v $ +## Revision 1.6 2003/02/21 01:47:53 joko +## renamed core function +## +## Revision 1.5 2003/02/20 20:24:33 joko +## + additional pre-flight checks +## +## Revision 1.4 2003/02/14 14:14:38 joko +## + new code refactored here +## ## Revision 1.3 2003/02/11 07:54:55 joko ## + modified module usage ## + debugging trials @@ -37,7 +46,7 @@ use Data::Dumper; use Hash::Merge qw( merge ); use libdb qw( hash2Sql ); -use Data::Transform::Deep qw( hash2object ); +use Data::Transform::Deep qw( merge_to ); # get logger instance @@ -127,6 +136,17 @@ my $ident = shift; my $force = shift; +=pod + #print "isa: ", UNIVERSAL::isa($self->{meta}->{$descent}->{storage}), "\n"; + + # this seems to be the first time we access this side, + # so just check (again) for a valid storage handle + if (! ref $self->{meta}->{$descent}->{storage}) { + $logger->critical( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident ): Storage handle undefined!" ); + return; + } +=cut + #$logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); # fetch entry to retrieve checksum from @@ -234,6 +254,13 @@ next; } + # 2.b check storage handle type + my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type}; + if (!$dbType) { + $logger->critical( __PACKAGE__ . "->touchNodeSet: Storage ( descent='$descent', dbKey='$dbkey' ) has no 'dbType' - configuration-error?" ); + next; + } + # 3. check if descents (and nodes?) are actually available.... # TODO: # eventually pre-check mode of access-attempt (read/write) here to provide an "early-croak" if possible @@ -242,7 +269,6 @@ # print Dumper($self->{meta}->{$descent}->{storage}->{locator}); - my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type}; my $nodeName = $self->{meta}->{$descent}->{nodeName}; my $accessorType = $self->{meta}->{$descent}->{accessorType}; my $accessorName = $self->{meta}->{$descent}->{accessorName}; @@ -448,7 +474,7 @@ # mix in (merge) values ... # TODO: use Hash::Merge here? benchmark! # no! we'd need a Object::Merge here! it's *...2object* - hash2object($object, $map); + merge_to($object, $map); # trace #print Dumper($object); @@ -480,7 +506,7 @@ # mix in values #print Dumper($object); # TODO: use Hash::Merge here??? - hash2object($object, $map); + merge_to($object, $map); #print Dumper($object); #exit; @@ -499,14 +525,18 @@ #print Dumper($map_callbacks); foreach my $node (keys %{$map_callbacks->{write}}) { #print Dumper($node); - my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_write'; + + # ------------ half-redundant: make $self->callCallback($object, $value, $opts) + my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_write'; my $evalstring = $perl_callback . '( { object => $object, value => $map_callbacks->{write}->{$node}, storage => $self->{meta}->{$descent}->{storage} } );'; #print $evalstring, "\n"; exit; eval($evalstring); if ($@) { $error = 1; - print $@, "\n"; + $logger->error( __PACKAGE__ . "->_modifyNode: $@" ); + next; } + # ------------ half-redundant: make $self->callCallback($object, $value, $opts) #print "after eval", "\n"; @@ -541,5 +571,16 @@ } +sub _erase_all { + my $self = shift; + my $descent = shift; + #my $node = shift; + #print Dumper($self->{meta}->{$descent}); + #my $node = $self->{meta}->{$descent}->{nodeName}; + my $node = $self->{meta}->{$descent}->{accessorName}; + $logger->debug( __PACKAGE__ . "->_erase_all( node $node )" ); + $self->{meta}->{$descent}->{storage}->eraseAll($node); +} 1; +__END__