--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2002/12/16 06:46:09 1.19 +++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2002/12/16 20:49:17 1.20 @@ -1,8 +1,12 @@ ############################################ # -# $Id: Tangram.pm,v 1.19 2002/12/16 06:46:09 joko Exp $ +# $Id: Tangram.pm,v 1.20 2002/12/16 20:49:17 jonen Exp $ # # $Log: Tangram.pm,v $ +# Revision 1.20 2002/12/16 20:49:17 jonen +# + added sub 'getObjectByGuid()' +# + added functionality to use 'getObjectByGuid' at 'getObjectAsHash()' +# # Revision 1.19 2002/12/16 06:46:09 joko # + attempt to introduce a generic '_patchSchema' - cancelled! # @@ -549,11 +553,45 @@ return $object if $object; } +sub getObjectByGuid { + my $self = shift; + my $guid = shift; + my $options = shift; + + # Guid and Classname is needed + if(!$guid || !$options->{classname}) { + return; + } + + # TODO: create a deep_unload method (currently _all_ objects are unloaded) + # unload($oid) will only unload object, not deep object hashes + $self->{_COREHANDLE}->unload() if ($options->{destroy}); + + # search for object with given Classname and Guid + my $obj_tmp = $self->{_COREHANDLE}->remote($classname); + my @result = $self->{_COREHANDLE}->select($obj_tmp, $obj_tmp->{guid} eq $guid); + + # we searched for global unique identifer of some object, + # so it think we can trust there would be only one result + if($result[0]) { + return $result[0]; + } else { + return "No Object with Classname $classname and GUID $options->{guid} found!"; + } + +} + sub getObjectAsHash { my $self = shift; my $oid = shift; - my $options = shift; - my $obj = $self->getObject($oid, $options); + my $options = shift; + my $obj; + + if($options->{guid}) { + $obj = $self->getObjectByGuid($oid, $options); + } else { + $obj = $self->getObject($oid, $options); + } # build options (a callback to unload autovivified objects) for 'expand' # TODO: use $logger to write to debug here!