/[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.1 by cvsjoko, Thu Oct 10 03:44:07 2002 UTC revision 1.3 by joko, Thu Oct 17 03:56:55 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.3  2002/10/17 03:56:55  joko
7    #  + bugfix: trapped eval error
8    #
9    #  Revision 1.2  2002/10/17 00:10:05  joko
10    #  + removed dependency from tsobj.pm, schema is now independent
11    #  + sub getNewPerlObjectByPkgName
12    #  + sub deploySchema
13    #  + sub retreatSchema
14    #
15  #  Revision 1.1  2002/10/10 03:44:07  cvsjoko  #  Revision 1.1  2002/10/10 03:44:07  cvsjoko
16  #  + new  #  + new
17  #  #
# Line 27  our $metainfo = { Line 36  our $metainfo = {
36    'disconnectMethod' => 'disconnect',    'disconnectMethod' => 'disconnect',
37  };  };
38    
39    sub getNewPerlObjectByPkgName {
40      my $pkgname = shift;
41      my $args = shift;
42      $logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
43      my $evstring = "use $pkgname;";
44      eval($evstring);
45      $@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval: " .  $@ );
46      return $pkgname->new($args);
47    }
48    
49  sub connect {  sub connect {
50    
51      my $self = shift;      my $self = shift;
# Line 34  sub connect { Line 53  sub connect {
53      my $dsn = shift;      my $dsn = shift;
54      $dsn ||= $self->{dbi}->{dsn};      $dsn ||= $self->{dbi}->{dsn};
55            
56      $logger->debug( __PACKAGE__ . "->connect($dsn)" );      $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
57            
58      #my $storage = Tangram::Relational->connect( $schema, $dsn );      #my $storage = Tangram::Relational->connect( $schema, $dsn );
59      #my $storage = Tangram::mysql->connect( $schema, $dsn );      #my $storage = Tangram::mysql->connect( $schema, $dsn );
# Line 45  sub connect { Line 64  sub connect {
64  #      return;  #      return;
65  #    }  #    }
66    
67        my $obj = getNewPerlObjectByPkgName($self->{schema}, { EXPORT_OBJECTS => $self->{classnames} } );
68      require 'OSA/tsobj.pm';      $self->{schema_tangram} = $obj->getSchema();
69      tsobj::initSchema();      
70      #sleep 1;      #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn );
71      my $schema = tsobj::getSchema();      $self->{COREHANDLE} = Tangram::Relational->connect( $self->{schema_tangram}, $dsn );
     $self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn );  
72        
73      #$self->{STORAGEHANDLE_UNDERLYING} = $self->getUnderlyingStorage();      #$self->{STORAGEHANDLE_UNDERLYING} = $self->getUnderlyingStorage();
74      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
# Line 93  sub _getSubLayerHandle { Line 111  sub _getSubLayerHandle {
111        
112    # hack, make more generic!    # hack, make more generic!
113    if (!$self->{STORAGE_SUBLAYER}) {    if (!$self->{STORAGE_SUBLAYER}) {
114      my $loc = new Data::Storage::Locator( type => "DBI", dbi => $self->{dbi}, COREHANDLE => $self->{COREHANDLE}->{db} );      my $loc = Data::Storage::Locator->new( type => "DBI", dbi => $self->{dbi}, COREHANDLE => $self->{COREHANDLE}->{db} );
115      $self->{STORAGE_SUBLAYER} = new Data::Storage( $loc, { protected => 1 } );      $self->{STORAGE_SUBLAYER} = Data::Storage->new( $loc, { protected => 1 } );
116      #$self->{STORAGE_UNDER_THE_HOOD}->{STORAGEHANDLE}->_configureCOREHANDLE();      #$self->{STORAGE_UNDER_THE_HOOD}->{STORAGEHANDLE}->_configureCOREHANDLE();
117      #$self->{STORAGE_UNDER_THE_HOOD}->_configureCOREHANDLE();      #$self->{STORAGE_UNDER_THE_HOOD}->_configureCOREHANDLE();
118    }    }
# Line 144  sub configureCOREHANDLE { Line 162  sub configureCOREHANDLE {
162    
163  }  }
164    
165    sub deploySchema {
166      my $self = shift;
167      #my $dsn = $self->{locator}->{dbi}->{dsn};
168      my $dsn = $self->{dbi}->{dsn};
169      my $ok;
170      if ( my $dbh = DBI->connect($dsn, '', '', {
171                                                          PrintError => 0,
172                                                        } ) ) {
173        $ok = Tangram::Relational->deploy($self->{schema}, $dbh );
174        $dbh->disconnect();
175      }
176      return $ok;
177    }
178    
179    sub retreatSchema {
180      print "retreat\n";
181      my $self = shift;
182      #my $dsn = $self->{locator}->{dbi}->{dsn};
183      my $dsn = $self->{dbi}->{dsn};
184      my $ok;
185      if ( my $dbh = DBI->connect($dsn, '', '', {
186                                                          PrintError => 0,
187                                                        } ) ) {
188        $ok = Tangram::Relational->retreat($self->{schema}, $dbh );
189        $dbh->disconnect();
190      }
191      return $ok;
192    }
193    
194  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed