--- 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/04/09 07:27:02 1.8 @@ -1,4 +1,4 @@ -## $Id: StorageInterface.pm,v 1.2 2003/02/09 05:05:58 joko Exp $ +## $Id: StorageInterface.pm,v 1.8 2003/04/09 07:27:02 joko Exp $ ## ## Copyright (c) 2002 Andreas Motl ## @@ -6,6 +6,25 @@ ## ## ---------------------------------------------------------------------------------------- ## $Log: StorageInterface.pm,v $ +## Revision 1.8 2003/04/09 07:27:02 joko +## minor update (just cosmetics) +## +## 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 +51,8 @@ use Data::Dumper; use Hash::Merge qw( merge ); -use libdb qw( quotesql hash2Sql ); -use Data::Transform::Deep qw( hash2object refexpr2perlref ); +use shortcuts::db qw( hash2sql ); +use Data::Mungle::Transform::Deep qw( merge_to ); # get logger instance @@ -57,8 +76,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 +92,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 +142,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: @@ -146,10 +183,6 @@ ] }; - # trace - #print "query:", "\n"; - #print Dumper($query); - # send query and fetch first entry from result my $result = $self->{meta}->{$descent}->{storage}->sendQuery($query); my $entry = $result->getNextEntry(); @@ -223,6 +256,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 +271,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}; @@ -316,10 +355,10 @@ # TODO: wrap this around '$storageHandle->sendQuery(...)'!? my $sql_main; if (lc($action) eq 'insert') { - $sql_main = hash2Sql($self->{meta}->{$descent}->{accessorName}, $map, 'SQL_INSERT'); + $sql_main = hash2sql($self->{meta}->{$descent}->{accessorName}, $map, 'SQL_INSERT'); } elsif (lc $action eq 'update') { $crit ||= "$self->{meta}->{$descent}->{IdentProvider}->{arg}='$self->{node}->{$descent}->{ident}'"; - $sql_main = hash2Sql($self->{meta}->{$descent}->{accessorName}, $map, 'SQL_UPDATE', $crit); + $sql_main = hash2sql($self->{meta}->{$descent}->{accessorName}, $map, 'SQL_UPDATE', $crit); } my $sqlHandle = $self->{meta}->{$descent}->{storage}->sendCommand($sql_main); @@ -437,7 +476,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); @@ -461,25 +500,20 @@ } elsif (lc $action eq 'update') { - # get fresh object from orm first + # Get fresh object from orm first. + # TODO: Review, is a 'sendQuery' required in this place? + # By now: NO! It's more expensive and we can just expect existing objects for update operations. + # If it doesn't exist either, we assume the engine will fail on issuing the 'update' operation later... $object = $self->{meta}->{$descent}->{storage}->load($self->{node}->{$descent}->{ident}); -#print Dumper($self->{node}); - # mix in values - #print Dumper($object); - # TODO: use Hash::Merge here??? - hash2object($object, $map); - #print Dumper($object); - #exit; + merge_to($object, $map); # update orm - $self->{meta}->{$descent}->{storage}->update($object); + $self->{meta}->{$descent}->{storage}->update($object); } -#exit; - my $error = 0; # handle new style callbacks - this is a HACK - do this without an eval! @@ -488,14 +522,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 +568,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__