--- nfo/perl/libs/Data/Transfer/Sync/StorageInterface.pm 2003/02/09 05:05:58 1.2 +++ nfo/perl/libs/Data/Transfer/Sync/StorageInterface.pm 2003/03/27 15:31:16 1.7 @@ -1,4 +1,4 @@ -## $Id: StorageInterface.pm,v 1.2 2003/02/09 05:05:58 joko Exp $ +## $Id: StorageInterface.pm,v 1.7 2003/03/27 15:31:16 joko Exp $ ## ## Copyright (c) 2002 Andreas Motl ## @@ -6,6 +6,22 @@ ## ## ---------------------------------------------------------------------------------------- ## $Log: StorageInterface.pm,v $ +## Revision 1.7 2003/03/27 15:31:16 joko +## fixes to modules regarding new namespace(s) below Data::Mungle::* +## +## 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 +## ## Revision 1.2 2003/02/09 05:05:58 joko ## + major structure changes ## - refactored code to sister modules @@ -32,8 +48,8 @@ use Data::Dumper; use Hash::Merge qw( merge ); -use libdb qw( quotesql hash2Sql ); -use Data::Transform::Deep qw( hash2object refexpr2perlref ); +use libdb qw( hash2Sql ); +use Data::Mungle::Transform::Deep qw( merge_to ); # get logger instance @@ -57,8 +73,11 @@ my $self = shift; my $descent = shift; - #print Dumper($self->{node}->{$descent}); - #print Dumper($self); + # trace + #print Dumper($self->{node}->{$descent}); + #print Dumper($self); + #exit; + $logger->debug( __PACKAGE__ . "->_resolveNodeIdent( descent=$descent, accessorName=$self->{meta}->{$descent}->{accessorName} )" ); # get to the payload @@ -70,6 +89,10 @@ #my $ident = $self->{$descent}->id($item); #my $ident = $self->{meta}->{$descent}->{storage}->id($item); + # trace + #print Dumper($self->{meta}->{$descent}); + #exit; + my $ident; my $provider_method = $self->{meta}->{$descent}->{IdentProvider}->{method}; my $provider_arg = $self->{meta}->{$descent}->{IdentProvider}->{arg}; @@ -116,7 +139,18 @@ my $ident = shift; my $force = shift; - $logger->debug( __PACKAGE__ . "->_statloadNode( descent=$descent ident=$ident )" ); +=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 # was: @@ -223,6 +257,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 @@ -231,7 +272,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}; @@ -437,7 +477,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); @@ -469,7 +509,7 @@ # mix in values #print Dumper($object); # TODO: use Hash::Merge here??? - hash2object($object, $map); + merge_to($object, $map); #print Dumper($object); #exit; @@ -488,14 +528,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"; @@ -530,5 +574,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__