--- nfo/perl/libs/Data/Storage/Handler/Tangram.pm	2002/11/17 06:35:18	1.5
+++ nfo/perl/libs/Data/Storage/Handler/Tangram.pm	2002/12/01 22:25:51	1.8
@@ -1,8 +1,24 @@
-#################################
+############################################
 #
-#  $Id: Tangram.pm,v 1.5 2002/11/17 06:35:18 joko Exp $
+#  $Id: Tangram.pm,v 1.8 2002/12/01 22:25:51 joko Exp $
 #
 #  $Log: Tangram.pm,v $
+#  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
+#  - sub existsChildNode (moved to Abstract.pm)
+#  + sub getListUnfiltered
+#  + sub getListFiltered
+#  + sub createCursor
+#  + sub createSet
+#  + sub sendQuery
+#
 #  Revision 1.5  2002/11/17 06:35:18  joko
 #  + locator metadata can now be reached via ->{locator}
 #  - getChildNodes is now wrapped via COREHANDLE
@@ -25,8 +41,8 @@
 #  Revision 1.1  2002/10/10 03:44:07  cvsjoko
 #  + new
 #
-#
-#################################
+############################################
+
 
 package Data::Storage::Handler::Tangram;
 
@@ -37,23 +53,20 @@
 
 use Tangram;
 use Data::Dumper;
+use libp qw( getNewPerlObjectByPkgName );
+use Data::Storage::Result::Tangram;
+use Data::Compare::Struct qw( isEmpty );
 
 # get logger instance
 my $logger = Log::Dispatch::Config->instance;
 
 
-our $metainfo = {
-  'disconnectMethod' => 'disconnect',
-};
-
-sub getNewPerlObjectByPkgName {
-  my $pkgname = shift;
-  my $args = shift;
-  $logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
-  my $evstring = "use $pkgname;";
-  eval($evstring);
-  $@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " .  $@ );
-  return $pkgname->new($args);
+sub getMetaInfo {
+  my $self = shift;
+  $logger->debug( __PACKAGE__ . "->getMetaInfo()"  );
+  return {
+    'disconnectMethod' => 'disconnect',
+  };
 }
 
 sub _initSchema {
@@ -90,12 +103,16 @@
 
     return unless $self->_initSchema();
 
+    # create the main tangram storage object
     #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn );
     $self->{COREHANDLE} = Tangram::Relational->connect( $self->{schema_tangram}, $dsn );
   
+    # some attempts for configuring the wrapped underlying dbi.....
     #$self->{STORAGEHANDLE_UNDERLYING} = $self->getUnderlyingStorage();
     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
     #$self->_configureUnderlyingStorage;
+    
+    # ..... encapsulation wins!
     $self->configureCOREHANDLE();
 
   $self->{locator}->{status}->{connected} = 1;
@@ -114,6 +131,9 @@
   # create new DBI - Data::Storage - object from already connected DBI::db - handle inside the current COREHANDLE
   #my $loc = new Data::Storage::Locator( type => "DBI", dbi => { db => $self->{COREHANDLE}->{db} });
   #my $loc = new Data::Storage::Locator( type => "DBI", COREHANDLE => $self->{COREHANDLE}->{db} );
+  
+  # todo: should we retrieve information from the schema here
+  # rather than poorly getting table names from underlying dbi?
   my $storage = $self->_getSubLayerHandle();
   @nodes = @{$storage->getChildNodes()};
   #$storage->_configureCOREHANDLE();
@@ -121,7 +141,8 @@
 #print Dumper($self);
   #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
   
-  $storage->disconnect();
+  # TODO: REVIEW
+  #$storage->disconnect();
   
   $self->{meta}->{childnodes} = \@nodes;
   
@@ -130,16 +151,6 @@
 }
 
 
-sub existsChildNode {
-  my $self = shift;
-  my $nodename = shift;
-  $logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );
-  $self->getChildNodes() unless $self->{meta}->{childnodes};
-  #print Dumper($self->{meta}->{childnodes});
-  return grep $nodename, @{$self->{meta}->{childnodes}};
-}
-
-
 sub testIntegrity {
 
   my $self = shift;
@@ -235,18 +246,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();
   }
@@ -257,15 +262,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();
     
@@ -273,10 +274,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;
 }
@@ -301,4 +309,152 @@
   return $res;
 }
 
+sub getListUnfiltered {
+  my $self = shift;
+  my $nodename = shift;
+  my @results;
+  $logger->debug( __PACKAGE__ . "->getListUnfiltered( nodename => '" . $nodename . "' )" );
+  # get set of objects from odbms by object name
+  my $object_set = $self->{COREHANDLE}->remote($nodename);
+  @results = $self->{COREHANDLE}->select($object_set);
+  return \@results;
+}
+
+sub getListFiltered {
+  my $self = shift;
+
+  # redirect to unfiltered mode
+  #return $self->getListUnfiltered(@_);
+
+  my $nodename = shift;
+  my $filters = shift;
+  my @results;
+  $logger->debug( __PACKAGE__ . "->getListFiltered( nodename => '" . $nodename . "' )" );
+
+  #print Dumper($filters);
+  
+  my @tfilters;
+  
+  foreach my $filter (@$filters) {
+  
+    # get filter - TODO: for each filter
+    #my $filter = $filters->[0];
+  
+    # build filter
+    my $lexpr = $filter->{key};
+    #my $op = $filter->{op};
+    my $op = '=';
+    my $rexpr = $filter->{val};
+    my $tight = 100;
+    
+  #  my $tfilter = Tangram::Filter->new(
+  #    expr => "t1.$lexpr $op '$rexpr'",
+  #    tight => $tight,
+  #    objects => $objects,
+  #  );
+  
+    # HACK: build eval-string (sorry) to get filtered list - please give advice here
+    push @tfilters, '$remote->{' . $filter->{key} . '}' . " $filter->{op} '$filter->{val}'";
+
+  }
+
+  my $tfilter = join(' & ', @tfilters);
+
+  # get set of objects from odbms by object name
+  my $remote = $self->{COREHANDLE}->remote($nodename);
+  
+  # was:
+  #@results = $self->{COREHANDLE}->select($object_set, $tfilter);
+
+  # is:
+  # HACK: build eval-string (sorry) to get filtered list - please give advice here
+  my $evalstring = 'return $self->{COREHANDLE}->select($remote, ' . $tfilter . ');';
+  
+  # get filtered list/set
+  @results = eval($evalstring);
+  die $@ if $@;
+  
+  return \@results;
+}
+
+sub createCursor {
+  my $self = shift;
+  my $node = shift;
+  my $cmdHandle = $self->{COREHANDLE}->cursor($node);
+  my $result = Data::Storage::Result::Tangram->new( RESULTHANDLE => $cmdHandle );
+  return $result;
+}
+
+sub createSet {
+  my $self = shift;
+  my @objects = @_;
+  my $rh = Set::Object->new();
+  foreach (@objects) {
+    #print Dumper($_);
+    $rh->insert($_) if !isEmpty($_);
+  }
+  #print Dumper($rh->members());
+  my $result = Data::Storage::Result::Tangram->new( RESULTHANDLE => $rh );
+  return $result;
+}
+
+sub sendQuery {
+  my $self = shift;
+  my $query = shift;
+  #my $sql = "SELECT cs FROM $self->{metainfo}->{$descent}->{node} WHERE $self->{metainfo}->{$descent}->{IdentProvider}->{arg}='$self->{entry}->{source}->{ident}';";
+  #my $result = $self->{metainfo}->{$descent}->{storage}->sendCommand($sql);
+
+  #print Dumper($query);
+
+  # HACK: special case: querying by id does not translate into a common tangram query
+  # just load the object by given id(ent)
+  if ($query->{criterias}->[0]->{key} eq 'id' && $query->{criterias}->[0]->{op} eq 'eq') {
+    #print "LOAD!!!", "\n";
+    #exit;
+    #return Set::Object->new( $self->{COREHANDLE}->load($query->{criterias}->[0]->{val}) );
+    my $ident = $query->{criterias}->[0]->{val};
+#print "load obj", "\n";
+    #return $self->createSet() if $ident == 5;
+    my $object = $self->{COREHANDLE}->load($ident);
+#print "get id", "\n";
+    my $oid = $self->{COREHANDLE}->id($object);
+    return $self->createSet($object);
+    #return $self->createSet( $self->{COREHANDLE}->load('300090018') );
+  }
+
+  die("This should not be reached for now - redirect to \$self->getListFiltered() here!");
+
+  # TODO: do a common tangram query here
+
+  my @crits;
+  foreach (@{$query->{criterias}}) {
+    my $op = '';
+    $op = '=' if lc $_->{op} eq 'eq';
+    push @crits, "$_->{key}$op'$_->{val}'";
+  }
+  my $subnodes = {};
+  map { $subnodes->{$_}++ } @{$query->{subnodes}};
+  # HACK: this is hardcoded ;(    expand possibilities!
+  #my $crit = join(' AND ', @crits);
+  #my $sql = hash2Sql($query->{node}, $subnodes, 'SELECT', $crit);
+  #return $self->sendCommand($sql);
+  #my $h = $self->{COREHANDLE}->remote($query->{node});
+  #my $res = $self->{COREHANDLE}->select($h, $h->{);
+  return $self->createCursor($query->{node});
+}
+
+sub eraseAll {
+  my $self = shift;
+  my $classname = shift;
+  my $remote = $self->{storage}->remote($classname);
+  my @objs = $self->{storage}->select($remote);
+  $self->{COREHANDLE}->erase(@objs);
+}
+
+sub createDb {
+  my $self = shift;
+  my $storage = $self->_getSubLayerHandle();
+  return $storage->createDb();
+}
+
 1;