--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2002/12/16 22:20:49 1.21 +++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm 2003/01/30 22:29:47 1.26 @@ -1,8 +1,23 @@ ############################################ # -# $Id: Tangram.pm,v 1.21 2002/12/16 22:20:49 jonen Exp $ +# $Id: Tangram.pm,v 1.26 2003/01/30 22:29:47 joko Exp $ # # $Log: Tangram.pm,v $ +# 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' +# +# Revision 1.24 2002/12/22 14:13:01 joko +# + sub dropDb +# +# Revision 1.23 2002/12/19 16:31:53 joko +# +- renamed sub to 'rebuildDb' +# +# Revision 1.22 2002/12/18 22:28:16 jonen +# + added extended logging at 'getObjectByGuid()' +# # Revision 1.21 2002/12/16 22:20:49 jonen # + fixed bug at 'getObjectByGuid()' # @@ -98,13 +113,12 @@ use Tangram; use Data::Dumper; -use libp qw( getNewPerlObjectByPkgName ); +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 ); - # get logger instance my $logger = Log::Dispatch::Config->instance; @@ -124,7 +138,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) { @@ -157,8 +172,12 @@ my $self = shift; my $dsn = shift; + +#print Dumper($self); +#exit; + + # TODO: re-enable $dsn ||= $self->{locator}->{dbi}->{dsn}; - $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" ); #my $storage = Tangram::Relational->connect( $schema, $dsn ); @@ -170,7 +189,8 @@ # return; # } - return unless $self->_initSchema(); + #return unless $self->_initSchema(); + $self->_initSchema(); # create the main tangram storage object #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn ); @@ -297,6 +317,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}) { @@ -362,9 +384,9 @@ return $ok; } -sub rebuildDbAndSchema { +sub rebuildDb { my $self = shift; - $logger->info( __PACKAGE__ . "->rebuildDbAndSchema()" ); + $logger->info( __PACKAGE__ . "->rebuildDb()" ); my @results; # sum up results (bool (0/1)) in array @@ -563,6 +585,7 @@ # Guid and Classname is needed if(!$guid || !$options->{classname}) { + $logger->error( __PACKAGE__ . "->getObjectByGuid: No 'guid' OR no Classname in options hash was given but needed!" ); return; } @@ -575,11 +598,12 @@ 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 + # so I think we can trust there would be only one result if($result[0]) { return $result[0]; } else { - return "No Object with Classname $options->{classname} and GUID $options->{guid} found!"; + $logger->error( __PACKAGE__ . "->getObjectByGuid: No Object with Classname $options->{classname} and GUID $guid found!" ); + return; } } @@ -637,4 +661,17 @@ return $self->{_COREHANDLE}; } +sub dropDb { + my $self = shift; + my $storage = $self->_getSubLayerHandle(); + return $storage->dropDb(); +} + +sub testAvailability { + my $self = shift; + my $storage = $self->_getSubLayerHandle(); + return $storage->testAvailability(); +} + 1; +__END__