/[cvs]/nfo/perl/libs/Data/Storage/Handler/Tangram.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Storage/Handler/Tangram.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by joko, Sun Dec 1 04:46:19 2002 UTC revision 1.9 by joko, Tue Dec 3 05:29:40 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.9  2002/12/03 05:29:40  joko
7    #  + sub getObject
8    #  + sub getObjectAsHash
9    #
10    #  Revision 1.8  2002/12/01 22:25:51  joko
11    #  + now utilizing metadata from storage locator when connecting to DBI in "raw"-mode
12    #
13  #  Revision 1.7  2002/12/01 04:46:19  joko  #  Revision 1.7  2002/12/01 04:46:19  joko
14  #  + sub eraseAll  #  + sub eraseAll
15  #  #
# Line 53  use Data::Dumper; Line 60  use Data::Dumper;
60  use libp qw( getNewPerlObjectByPkgName );  use libp qw( getNewPerlObjectByPkgName );
61  use Data::Storage::Result::Tangram;  use Data::Storage::Result::Tangram;
62  use Data::Compare::Struct qw( isEmpty );  use Data::Compare::Struct qw( isEmpty );
63    use Data::Transform::Deep qw( var_deref );
64    use Data::Transform::Encode qw( var2utf8 );
65    
66    
67  # get logger instance  # get logger instance
68  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 138  sub getChildNodes { Line 148  sub getChildNodes {
148  #print Dumper($self);  #print Dumper($self);
149    #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {    #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
150        
151    $storage->disconnect();    # TODO: REVIEW
152      #$storage->disconnect();
153        
154    $self->{meta}->{childnodes} = \@nodes;    $self->{meta}->{childnodes} = \@nodes;
155        
# Line 242  sub deploySchema { Line 253  sub deploySchema {
253    my $args = shift;    my $args = shift;
254        
255    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
   #my $dsn = $self->{dbi}->{dsn};  
256    
257    $logger->debug( __PACKAGE__ . "->deploySchema( dsn $dsn )" );    $logger->debug( __PACKAGE__ . "->deploySchema( dsn $dsn )" );
258    
259    my $ok;    my $ok;
260    # TODO: is this DBI->connect okay here like it is? regarding errors.....???    if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {
   if ( my $dbh = DBI->connect($dsn, '', '', {  
                                                       PrintError => 0,  
                                                     } ) ) {  
   
261      return unless $self->_initSchema();      return unless $self->_initSchema();
       
262      $ok = Tangram::Relational->deploy($self->{schema_tangram}, $dbh );      $ok = Tangram::Relational->deploy($self->{schema_tangram}, $dbh );
263      $dbh->disconnect();      $dbh->disconnect();
264    }    }
# Line 264  sub retreatSchema { Line 269  sub retreatSchema {
269    
270    my $self = shift;    my $self = shift;
271    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
   #my $dsn = $self->{dbi}->{dsn};  
272    
273    $logger->debug( __PACKAGE__ . "->retreatSchema( dsn $dsn )" );    $logger->debug( __PACKAGE__ . "->retreatSchema( dsn $dsn )" );
274    
275    my $ok;    my $ok;
276    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) {
                                                       #PrintError => 0,  
                                                       #RaiseError => 0,  
                                                     } ) ) {  
277    
278      return unless $self->_initSchema();      return unless $self->_initSchema();
279            
# Line 280  sub retreatSchema { Line 281  sub retreatSchema {
281      $self->{dataStorageLayer}->removeLogDispatchHandler("Tangram11");      $self->{dataStorageLayer}->removeLogDispatchHandler("Tangram11");
282            
283      $ok = Tangram::Relational->retreat($self->{schema_tangram}, $dbh );      $ok = Tangram::Relational->retreat($self->{schema_tangram}, $dbh );
284      $ok = 2;    # answer is "maybe" for now since Tangram::Relational->retreat doesn't seem to return a valid status  
285                      # idea: test this by checking for count of tables in database -      # answer "$ok=2" means "maybe" for now - we have to patch this to a constant here because...
286                      #          problem with this: there may be some left not having been included to the schema      # - ... Tangram::Relational->retreat doesn't seem to return a valid status
287        # - possible improvement:
288        #   - test this by checking for count of tables in database
289        #   - problem with this: there may be some left not having been included to the schema
290        #   - maybe better: use "->getChildNodes"?
291        $ok = 2;
292    
293      $dbh->disconnect();      $dbh->disconnect();
294    
295    }    }
296    return $ok;    return $ok;
297  }  }
# Line 450  sub eraseAll { Line 458  sub eraseAll {
458    $self->{COREHANDLE}->erase(@objs);    $self->{COREHANDLE}->erase(@objs);
459  }  }
460    
461    sub createDb {
462      my $self = shift;
463      my $storage = $self->_getSubLayerHandle();
464      return $storage->createDb();
465    }
466    
467    sub getObject {
468      my $self = shift;
469      my $oid = shift;
470      # TODO: review this
471      #if (!$self->{COREHANDLE}) { return; }
472      return $self->{COREHANDLE}->load($oid);
473    }
474    
475    sub getObjectAsHash {
476      my $self = shift;
477      my $oid = shift;
478      my $options = shift;
479      my $obj = $self->getObject($oid);
480      my $deref = var_deref($obj);
481      var2utf8($deref) if ($options->{utf8});
482      return $deref;
483    }
484    
485  1;  1;
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed