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