--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2003/01/19 02:30:05 1.25 +++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2003/02/20 20:20:26 1.28 @@ -1,8 +1,17 @@ ############################################ # -# $Id: Tangram.pm,v 1.25 2003/01/19 02:30:05 joko Exp $ +# $Id: Tangram.pm,v 1.28 2003/02/20 20:20:26 joko Exp $ # # $Log: Tangram.pm,v $ +# Revision 1.28 2003/02/20 20:20:26 joko +# tried to get auto-disconnect working again - failed with that +# +# Revision 1.27 2003/01/31 06:30:59 joko +# + enabled 'sendQuery' +# +# Revision 1.26 2003/01/30 22:29:47 joko +# + fixed module usage (removed dependency on 'libp.pm') +# # Revision 1.25 2003/01/19 02:30:05 joko # + fix: modified call to '_initSchema' # @@ -35,7 +44,7 @@ # + fix: encapsulated object-loading inside an 'eval' # # Revision 1.15 2002/12/05 13:55:21 joko -# + now utilizing 'object2hash' instead of 'var_deref' +# + now utilizing 'expand' instead of 'var_deref' # + played around with having fresh-objects - no progress.... # # Revision 1.14 2002/12/05 09:40:30 jonen @@ -108,14 +117,15 @@ use base ("Data::Storage::Handler"); use base ("Data::Storage::Handler::Abstract"); -use Tangram; + use Data::Dumper; -use libp qw( getNewPerlObjectByPkgName ); +use Tangram; + +use DesignPattern::Object; use Data::Storage::Result::Tangram; use Data::Compare::Struct qw( isEmpty ); -use Data::Transform::Deep qw( object2hash ); -use Data::Transform::Encode qw( var2utf8 ); - +use Data::Transform::Deep qw( expand ); +#use Data::Transform::Encode qw( var2utf8 ); # get logger instance my $logger = Log::Dispatch::Config->instance; @@ -136,7 +146,8 @@ my $self = shift; $logger->debug( __PACKAGE__ . "->_initSchema()" ); #if (!$schema_tangram) { - my $obj = getNewPerlObjectByPkgName($self->{locator}->{schema}, { EXPORT_OBJECTS => $self->{locator}->{classnames}, want_transactions => $self->{locator}->{want_transactions} } ); + #my $obj = getNewPerlObjectByPkgName($self->{locator}->{schema}, { EXPORT_OBJECTS => $self->{locator}->{classnames}, want_transactions => $self->{locator}->{want_transactions} } ); + my $obj = DesignPattern::Object->fromPackage($self->{locator}->{schema}, { 'EXPORT_OBJECTS' => $self->{locator}->{classnames}, 'want_transactions' => $self->{locator}->{want_transactions} } ); $schema_tangram = $obj->getSchema(); #} if (!$schema_tangram) { @@ -314,6 +325,8 @@ $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" ); #my $subLayer = $self->_getSubLayerHandle(); + #print Dumper($self); + #exit; # apply configured modifications if (exists $self->{dbi}->{trace_level} && exists $self->{dbi}->{trace_file}) { @@ -421,7 +434,7 @@ my @results; $logger->debug( __PACKAGE__ . "->getListFiltered( nodename => '" . $nodename . "' )" ); - #print Dumper($filters); +#print Dumper($filters); my @tfilters; @@ -460,6 +473,8 @@ # HACK: build eval-string (sorry) to get filtered list - please give advice here my $evalstring = 'return $self->{_COREHANDLE}->select($remote, ' . $tfilter . ');'; + #print "eval: $evalstring", "\n"; + # get filtered list/set @results = eval($evalstring); die $@ if $@; @@ -519,10 +534,18 @@ #return $self->createSet( $self->{COREHANDLE}->load('300090018') ); } - die("This should not be reached for now - redirect to \$self->getListFiltered() here!"); + my $list = $self->getListFiltered($query->{node}, $query->{criterias}); + #return $self->createSet($object); + #return $self->createSet($list); + return $self->createSet(@$list); + + #die("This should not be reached for now - redirect to \$self->getListFiltered() here!"); + + - # TODO: do a common tangram query here + # try a generic tangram query here + # TODO: try to place an oql on top of that (search.cpan.org!) my @crits; foreach (@{$query->{criterias}}) { my $op = ''; @@ -630,12 +653,12 @@ } =cut - my $hash = object2hash($obj, $options); + my $hash = expand($obj, $options); #$options->{cb}->{destroy}->($obj); #$self->{_COREHANDLE}->unload($obj); # convert values in hash to utf8 to be ready for (e.g.) encapsulation in XML - # now done in object2hash + # now done in expand #var2utf8($hash) if ($options->{utf8}); # old (wrong) attempts to get rid of used instances, if requested @@ -662,4 +685,27 @@ return $storage->dropDb(); } +sub testAvailability { + my $self = shift; + my $storage = $self->_getSubLayerHandle(); + return $storage->testAvailability(); +} + +sub disconnect2 { + my $self = shift; + my $storage = $self->_getSubLayerHandle(); + print "DISC!", "\n"; + + my $storage_ll = $storage->{_COREHANDLE}; + $storage_ll->disconnect(); + + print Dumper($storage); + exit; + + #$self->{_COREHANDLE} + #$storage->disconnect(); + $self->{dataStorageLayer}->disconnect(); +} + 1; +__END__