/[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.3 by joko, Thu Oct 17 03:56:55 2002 UTC revision 1.5 by joko, Sun Nov 17 06:35:18 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.5  2002/11/17 06:35:18  joko
7    #  + locator metadata can now be reached via ->{locator}
8    #  - getChildNodes is now wrapped via COREHANDLE
9    #
10    #  Revision 1.4  2002/10/25 11:44:44  joko
11    #  + sub _initSchema
12    #  + sub existsChildNode
13    #  + sub testIntegrity
14    #  + sub rebuildDbAndSchema
15    #
16  #  Revision 1.3  2002/10/17 03:56:55  joko  #  Revision 1.3  2002/10/17 03:56:55  joko
17  #  + bugfix: trapped eval error  #  + bugfix: trapped eval error
18  #  #
# Line 42  sub getNewPerlObjectByPkgName { Line 52  sub getNewPerlObjectByPkgName {
52    $logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );    $logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
53    my $evstring = "use $pkgname;";    my $evstring = "use $pkgname;";
54    eval($evstring);    eval($evstring);
55    $@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval: " .  $@ );    $@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " .  $@ );
56    return $pkgname->new($args);    return $pkgname->new($args);
57  }  }
58    
59    sub _initSchema {
60      my $self = shift;
61      $logger->debug( __PACKAGE__ . "->_initSchema()" );
62      #if (!$self->{schema_tangram}) {
63        my $obj = getNewPerlObjectByPkgName($self->{locator}->{schema}, { EXPORT_OBJECTS => $self->{locator}->{classnames}, want_transactions => $self->{locator}->{want_transactions} } );
64        $self->{schema_tangram} = $obj->getSchema();
65      #}
66      if (!$self->{schema_tangram}) {
67        $logger->error( __PACKAGE__ . "->_initSchema: No Schema available for $self->{schema}" );
68        return 0;
69      }
70      return 1;
71    }
72    
73  sub connect {  sub connect {
74    
75      my $self = shift;      my $self = shift;
76            
77      my $dsn = shift;      my $dsn = shift;
78      $dsn ||= $self->{dbi}->{dsn};      $dsn ||= $self->{locator}->{dbi}->{dsn};
79            
80      $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );      $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" );
81            
# Line 64  sub connect { Line 88  sub connect {
88  #      return;  #      return;
89  #    }  #    }
90    
91      my $obj = getNewPerlObjectByPkgName($self->{schema}, { EXPORT_OBJECTS => $self->{classnames} } );      return unless $self->_initSchema();
92      $self->{schema_tangram} = $obj->getSchema();  
       
93      #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn );      #$self->{COREHANDLE} = Tangram::Relational->connect( $schema, $dsn );
94      $self->{COREHANDLE} = Tangram::Relational->connect( $self->{schema_tangram}, $dsn );      $self->{COREHANDLE} = Tangram::Relational->connect( $self->{schema_tangram}, $dsn );
95        
# Line 75  sub connect { Line 98  sub connect {
98      #$self->_configureUnderlyingStorage;      #$self->_configureUnderlyingStorage;
99      $self->configureCOREHANDLE();      $self->configureCOREHANDLE();
100    
101      $self->{locator}->{status}->{connected} = 1;
102    
103      return 1;
104    
105  }  }
106    
107  sub getChildNodes {  sub getChildNodes {
# Line 82  sub getChildNodes { Line 109  sub getChildNodes {
109    my $self = shift;    my $self = shift;
110    my @nodes;    my @nodes;
111    
112      $logger->debug( __PACKAGE__ . "->getChildNodes()" );
113    
114    # create new DBI - Data::Storage - object from already connected DBI::db - handle inside the current COREHANDLE    # create new DBI - Data::Storage - object from already connected DBI::db - handle inside the current COREHANDLE
115    #my $loc = new Data::Storage::Locator( type => "DBI", dbi => { db => $self->{COREHANDLE}->{db} });    #my $loc = new Data::Storage::Locator( type => "DBI", dbi => { db => $self->{COREHANDLE}->{db} });
116    #my $loc = new Data::Storage::Locator( type => "DBI", COREHANDLE => $self->{COREHANDLE}->{db} );    #my $loc = new Data::Storage::Locator( type => "DBI", COREHANDLE => $self->{COREHANDLE}->{db} );
117    my $storage = $self->_getSubLayerHandle();    my $storage = $self->_getSubLayerHandle();
118      @nodes = @{$storage->getChildNodes()};
119    #$storage->_configureCOREHANDLE();    #$storage->_configureCOREHANDLE();
120    #print "getchildnodes\n";
121    #print Dumper($self);
122    #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {    #if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) {
   if (my $result = $storage->sendCommand( 'SHOW TABLES;' ) ) {  
     while ( my $row = $result->_getNextEntry() ) {  
       push @nodes, $row;  
     }  
   }  
123        
124    $storage->disconnect();    $storage->disconnect();
125        
126      $self->{meta}->{childnodes} = \@nodes;
127      
128    return \@nodes;    return \@nodes;
129    
130  }  }
131    
132    
133    sub existsChildNode {
134      my $self = shift;
135      my $nodename = shift;
136      $logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );
137      $self->getChildNodes() unless $self->{meta}->{childnodes};
138      #print Dumper($self->{meta}->{childnodes});
139      return grep $nodename, @{$self->{meta}->{childnodes}};
140    }
141    
142    
143    sub testIntegrity {
144    
145      my $self = shift;
146    
147      $logger->debug( __PACKAGE__ . "->testIntegrity()" );
148    
149      # 1st test: are there tables?
150      if (!$self->getChildNodes()) {
151        $logger->warning( __PACKAGE__ . "->testIntegrity no childnodes exist" );
152        return;
153      }
154    
155      # 2nd test: is there a table named "Tangram"?
156      if (!$self->existsChildNode("Tangram")) {
157        $logger->warning( __PACKAGE__ . "->testIntegrity childnode \"Tangram\" doesn't exist" );
158        return;
159      }
160    
161      $self->{locator}->{status}->{integrity} = 1;
162      return 1;
163    
164    }
165    
166    
167  sub _getSubLayerHandle {  sub _getSubLayerHandle {
168        
169    my $self = shift;    my $self = shift;
170        
171    use Data::Dumper;    $logger->debug( __PACKAGE__ . "->_getSubLayerHandle()" );
172    
173    #print Dumper($self);    #print Dumper($self);
174      
175    # hack, make more generic!    # hack, make more generic!
176    if (!$self->{STORAGE_SUBLAYER}) {    if (!$self->{dataStorageLayer}) {
177      my $loc = Data::Storage::Locator->new( type => "DBI", dbi => $self->{dbi}, COREHANDLE => $self->{COREHANDLE}->{db} );      $logger->debug( __PACKAGE__ . "->_getSubLayerHandle() creating new dataStorageLayer" );
178      $self->{STORAGE_SUBLAYER} = Data::Storage->new( $loc, { protected => 1 } );      #my $loc = Data::Storage::Locator->new( type => "DBI", dbi => $self->{dbi}, COREHANDLE => $self->{COREHANDLE}->{db} );
179        my $loc = Data::Storage::Locator->new( { type => "DBI", dbi => $self->{locator}->{dbi} } );
180        $self->{dataStorageLayer} = Data::Storage->new( $loc, { protected => 1 } );
181      #$self->{STORAGE_UNDER_THE_HOOD}->{STORAGEHANDLE}->_configureCOREHANDLE();      #$self->{STORAGE_UNDER_THE_HOOD}->{STORAGEHANDLE}->_configureCOREHANDLE();
182      #$self->{STORAGE_UNDER_THE_HOOD}->_configureCOREHANDLE();      #$self->{STORAGE_UNDER_THE_HOOD}->_configureCOREHANDLE();
183    }    }
184        
185    #print Dumper($self->{STORAGE_UNDER_THE_HOOD});    #print Dumper($self->{STORAGE_UNDER_THE_HOOD});
186        
187    return $self->{STORAGE_SUBLAYER};    return $self->{dataStorageLayer};
188        
189  }  }
190    
191  sub _configureUnderlyingStorage {  sub _configureUnderlyingStorage {
192        
193    my $self = shift;    my $self = shift;
194    
195      $logger->debug( __PACKAGE__ . "->_configureUnderlyingStorage" );
196    
197    $self->_configureCOREHANDLE_DBI();    $self->_configureCOREHANDLE_DBI();
198    return;    return;
199        
# Line 142  sub configureCOREHANDLE { Line 210  sub configureCOREHANDLE {
210    
211    my $self = shift;    my $self = shift;
212    
213    $logger->debug( __PACKAGE__ . "->_configureCOREHANDLE" );    $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" );
214    
215    #my $subLayer = $self->_getSubLayerHandle();    #my $subLayer = $self->_getSubLayerHandle();
216    
# Line 164  sub configureCOREHANDLE { Line 232  sub configureCOREHANDLE {
232    
233  sub deploySchema {  sub deploySchema {
234    my $self = shift;    my $self = shift;
235    #my $dsn = $self->{locator}->{dbi}->{dsn};    my $args = shift;
236    my $dsn = $self->{dbi}->{dsn};    
237      my $dsn = $self->{locator}->{dbi}->{dsn};
238      #my $dsn = $self->{dbi}->{dsn};
239    
240      $logger->debug( __PACKAGE__ . "->deploySchema( dsn $dsn )" );
241    
242    my $ok;    my $ok;
243      # TODO: is this DBI->connect okay here like it is? regarding errors.....???
244    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
245                                                        PrintError => 0,                                                        PrintError => 0,
246                                                      } ) ) {                                                      } ) ) {
247      $ok = Tangram::Relational->deploy($self->{schema}, $dbh );  
248        return unless $self->_initSchema();
249        
250        $ok = Tangram::Relational->deploy($self->{schema_tangram}, $dbh );
251      $dbh->disconnect();      $dbh->disconnect();
252    }    }
253    return $ok;    return $ok;
254  }  }
255    
256  sub retreatSchema {  sub retreatSchema {
257    print "retreat\n";  
258    my $self = shift;    my $self = shift;
259    #my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
260    my $dsn = $self->{dbi}->{dsn};    #my $dsn = $self->{dbi}->{dsn};
261    
262      $logger->debug( __PACKAGE__ . "->retreatSchema( dsn $dsn )" );
263    
264    my $ok;    my $ok;
265    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
266                                                        PrintError => 0,                                                        #PrintError => 0,
267                                                          #RaiseError => 0,
268                                                      } ) ) {                                                      } ) ) {
269      $ok = Tangram::Relational->retreat($self->{schema}, $dbh );  
270        return unless $self->_initSchema();
271        
272        #use Data::Dumper; print Dumper($self);
273        $self->{dataStorageLayer}->removeLogDispatchHandler("Tangram11");
274        
275        $ok = Tangram::Relational->retreat($self->{schema_tangram}, $dbh );
276        $ok = 2;    # answer is "maybe" for now since Tangram::Relational->retreat doesn't seem to return a valid status
277                        # idea: test this by checking for count of tables in database -
278                        #          problem with this: there may be some left not having been included to the schema
279      $dbh->disconnect();      $dbh->disconnect();
280    }    }
281    return $ok;    return $ok;
282  }  }
283    
284    sub rebuildDbAndSchema {
285      my $self = shift;
286      $logger->info( __PACKAGE__ . "->rebuildDbAndSchema()" );
287      my @results;
288    
289      # sum up results (bool (0/1)) in array
290      push @results, $self->retreatSchema();
291      push @results, $self->{dataStorageLayer}->dropDb();
292      push @results, $self->{dataStorageLayer}->createDb();
293      push @results, $self->deploySchema();
294    
295      # scan array for "bad ones"
296      my $res = 1;
297      map {
298        $res = 0 if (!$_);
299      } @results;
300      
301      return $res;
302    }
303    
304  1;  1;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed