--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm	2002/11/29 05:02:30	1.6
+++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm	2002/12/04 08:54:08	1.11
@@ -1,8 +1,24 @@
 ############################################
 #
-#  $Id: Tangram.pm,v 1.6 2002/11/29 05:02:30 joko Exp $
+#  $Id: Tangram.pm,v 1.11 2002/12/04 08:54:08 jonen Exp $
 #
 #  $Log: Tangram.pm,v $
+#  Revision 1.11  2002/12/04 08:54:08  jonen
+#  + untested bugfix: undef($object) after transform to hash at getObjectAsHash
+#
+#  Revision 1.10  2002/12/03 15:53:23  joko
+#  + small bugfix regarding object hierarchy
+#
+#  Revision 1.9  2002/12/03 05:29:40  joko
+#  + sub getObject
+#  + sub getObjectAsHash
+#
+#  Revision 1.8  2002/12/01 22:25:51  joko
+#  + now utilizing metadata from storage locator when connecting to DBI in "raw"-mode
+#
+#  Revision 1.7  2002/12/01 04:46:19  joko
+#  + sub eraseAll
+#
 #  Revision 1.6  2002/11/29 05:02:30  joko
 #  - sub getNewPerlObjectByPkgName (moved to libp.pm)
 #  + sub getMetaInfo
@@ -50,6 +66,9 @@
 use libp qw( getNewPerlObjectByPkgName );
 use Data::Storage::Result::Tangram;
 use Data::Compare::Struct qw( isEmpty );
+use Data::Transform::Deep qw( var_deref );
+use Data::Transform::Encode qw( var2utf8 );
+
 
 # get logger instance
 my $logger = Log::Dispatch::Config->instance;
@@ -135,7 +154,8 @@
 #print Dumper($self);
   #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
   
-  $storage->disconnect();
+  # TODO: REVIEW
+  #$storage->disconnect();
   
   $self->{meta}->{childnodes} = \@nodes;
   
@@ -239,18 +259,12 @@
   my $args = shift;
   
   my $dsn = $self->{locator}->{dbi}->{dsn};
-  #my $dsn = $self->{dbi}->{dsn};
 
   $logger->debug( __PACKAGE__ . "->deploySchema( dsn $dsn )" );
 
   my $ok;
-  # TODO: is this DBI->connect okay here like it is? regarding errors.....???
-  if ( my $dbh = DBI->connect($dsn, '', '', {
-                                                      PrintError => 0,
-                                                    } ) ) {
-
+  if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {
     return unless $self->_initSchema();
-    
     $ok = Tangram::Relational->deploy($self->{schema_tangram}, $dbh );
     $dbh->disconnect();
   }
@@ -261,15 +275,11 @@
 
   my $self = shift;
   my $dsn = $self->{locator}->{dbi}->{dsn};
-  #my $dsn = $self->{dbi}->{dsn};
 
   $logger->debug( __PACKAGE__ . "->retreatSchema( dsn $dsn )" );
 
   my $ok;
-  if ( my $dbh = DBI->connect($dsn, '', '', {
-                                                      #PrintError => 0,
-                                                      #RaiseError => 0,
-                                                    } ) ) {
+  if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {
 
     return unless $self->_initSchema();
     
@@ -277,10 +287,17 @@
     $self->{dataStorageLayer}->removeLogDispatchHandler("Tangram11");
     
     $ok = Tangram::Relational->retreat($self->{schema_tangram}, $dbh );
-    $ok = 2;    # answer is "maybe" for now since Tangram::Relational->retreat doesn't seem to return a valid status
-                    # idea: test this by checking for count of tables in database - 
-                    #          problem with this: there may be some left not having been included to the schema
+
+    # answer "$ok=2" means "maybe" for now - we have to patch this to a constant here because...
+    # - ... Tangram::Relational->retreat doesn't seem to return a valid status
+    # - possible improvement:
+    #   - test this by checking for count of tables in database
+    #   - problem with this: there may be some left not having been included to the schema
+    #   - maybe better: use "->getChildNodes"?
+    $ok = 2;
+
     $dbh->disconnect();
+
   }
   return $ok;
 }
@@ -439,4 +456,37 @@
   return $self->createCursor($query->{node});
 }
 
+sub eraseAll {
+  my $self = shift;
+  my $classname = shift;
+  my $remote = $self->{COREHANDLE}->remote($classname);
+  my @objs = $self->{COREHANDLE}->select($remote);
+  $self->{COREHANDLE}->erase(@objs);
+}
+
+sub createDb {
+  my $self = shift;
+  my $storage = $self->_getSubLayerHandle();
+  return $storage->createDb();
+}
+
+sub getObject {
+  my $self = shift;
+  my $oid = shift;
+  # TODO: review this
+  #if (!$self->{COREHANDLE}) { return; }
+  return $self->{COREHANDLE}->load($oid);
+}
+
+sub getObjectAsHash {
+  my $self = shift;
+  my $oid = shift;
+  my $options = shift;
+  my $obj = $self->getObject($oid);
+  my $deref = var_deref($obj);
+  var2utf8($deref) if ($options->{utf8});
+  undef($obj) if($options->{destroy});
+  return $deref;
+}
+
 1;