/[cvs]/nfo/perl/libs/Data/Storage/Schema/Abstract.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Storage/Schema/Abstract.pm

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

revision 1.1 by joko, Thu Oct 17 00:07:14 2002 UTC revision 1.6 by jonen, Sun Nov 17 07:21:47 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.6  2002/11/17 07:21:47  jonen
7    #  + using Class::Tangram::import_schema() again for proper usage of its helper functions
8    #
9    #  Revision 1.5  2002/11/17 07:12:06  joko
10    #  + extended ::getProperties with argument "want_transactions"
11    #
12    #  Revision 1.4  2002/11/15 13:21:39  joko
13    #  + added capability to propagate global schema options from schema module to tangram schema
14    #
15    #  Revision 1.3  2002/11/09 01:27:23  joko
16    #  + dependency of Class::Tangram now is 1.13 at minimum
17    #
18    #  Revision 1.2  2002/10/25 11:45:10  joko
19    #  + enhanced robustness
20    #  + more logging for debug-levels
21    #
22  #  Revision 1.1  2002/10/17 00:07:14  joko  #  Revision 1.1  2002/10/17 00:07:14  joko
23  #  + new  #  + new
24  #  #
# Line 36  package Data::Storage::Schema::Abstract; Line 52  package Data::Storage::Schema::Abstract;
52      my $class = ref($invocant) || $invocant;      my $class = ref($invocant) || $invocant;
53      my @args = ();      my @args = ();
54      @_ && (@args = @_);      @_ && (@args = @_);
55      #$logger->debug( __PACKAGE__ . "->new(@args)" );      
56        $logger->debug( __PACKAGE__ . "->new" );
57    
58      #my $self = { @_ };      #my $self = { @_ };
59    
60      # merge all entries from all hashes in args-array to single array (key, val, key, val)      # merge all entries from all hashes in args-array to single array (key, val, key, val)
# Line 44  package Data::Storage::Schema::Abstract; Line 62  package Data::Storage::Schema::Abstract;
62      map { push(@args_all, %{$_}); } @args;      map { push(@args_all, %{$_}); } @args;
63      # make hash from array      # make hash from array
64      my %args = @args_all;      my %args = @args_all;
65    
66        #$logger->debug( __PACKAGE__ . "->new( @args_all )" );
67            
68      my $self = { %args };      my $self = { %args };
69      bless $self, $class;      bless $self, $class;
70    
71        #use Data::Dumper; print Dumper($self);
72    
73      # remember as which Class we are instantiated      # remember as which Class we are instantiated
74      $self->{invocant} = $invocant;      $self->{invocant} = $invocant;
75    
# Line 63  package Data::Storage::Schema::Abstract; Line 85  package Data::Storage::Schema::Abstract;
85      my $ctversion = $Class::Tangram::VERSION;      my $ctversion = $Class::Tangram::VERSION;
86      #print "ctversion: ", $ctversion, "\n";      #print "ctversion: ", $ctversion, "\n";
87      #if ($ctversion ne 1.04) {      #if ($ctversion ne 1.04) {
88      if ($ctversion ne 1.12) {      if ($ctversion lt 1.13) {
89        print "Version of \"Class::Tangram\": ", $ctversion, "\n";        print "Version of \"Class::Tangram\": ", $ctversion, "\n";
90        print "absolutely required version: ", "1.12", "\n";        print "minimum required version   : ", "1.13", "\n";
91        #print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";        #print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";
92        exit;        exit;
93      }      }
# Line 76  package Data::Storage::Schema::Abstract; Line 98  package Data::Storage::Schema::Abstract;
98      my $filename = shift;      my $filename = shift;
99      my $exclude_pattern = shift;      my $exclude_pattern = shift;
100      $logger->debug( __PACKAGE__ . "->_parsePackageFile( ... )" );      $logger->debug( __PACKAGE__ . "->_parsePackageFile( ... )" );
101        if (!$filename) {
102          $logger->error( __PACKAGE__ . "->_parsePackageFile: you must specify a filename" );
103          return;
104        }
105        if (! -e $filename) {
106          $logger->error( __PACKAGE__ . "->_parsePackageFile: could not find $filename" );
107        }
108      my @packages = ();      my @packages = ();
109      open(FH, '<' . $filename);      open(FH, '<' . $filename);
110      while (<FH>) {      while (<FH>) {
# Line 109  package Data::Storage::Schema::Abstract; Line 138  package Data::Storage::Schema::Abstract;
138      # parse complete package to build list of classes      # parse complete package to build list of classes
139      if ($#{$classlist} == -1) {      if ($#{$classlist} == -1) {
140        $logger->debug( "_doinit() Initializing all Classes from " . $self->{invocant} );        $logger->debug( "_doinit() Initializing all Classes from " . $self->{invocant} );
141        my $perl_packagename = $self->{invocant};        if (!$self->{invocant}->can('getFilename')) {
142            $logger->error( __PACKAGE__ . "->_doinit: Package $self->{invocant} doesn't contain method 'getFilename'" );
143            return;
144          }
145        my $perl_packagefile = eval('return ' . $self->{invocant} . '::getFilename();');        my $perl_packagefile = eval('return ' . $self->{invocant} . '::getFilename();');
146        my $packages = $self->_parsePackageNamesFromFile($perl_packagefile, $self->{invocant});        my $packages = $self->_parsePackageNamesFromFile($perl_packagefile, $self->{invocant});
147        # TODO:        # TODO:
# Line 117  package Data::Storage::Schema::Abstract; Line 149  package Data::Storage::Schema::Abstract;
149        $classlist = $packages;        $classlist = $packages;
150      }      }
151            
152        my $schema_properties = {};
153        if ($self->{invocant}->can('getProperties')) {
154          # TODO: rework this! call by ref and/or do oo
155          #$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');
156          $schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');
157        }
158        
159      # build argument to be passed to "Tangram::Schema->new(...)"      # build argument to be passed to "Tangram::Schema->new(...)"
160      my @classes;      my @classes;
161      map {      map {
162        $logger->debug( __PACKAGE__ . "->_doinit() Initializing Class $_" );        $logger->debug( __PACKAGE__ . "->_doinit: Initializing Class $_" );
163          Class::Tangram::import_schema($_);
164        # classname        # classname
165        push @classes, $_;        push @classes, $_;
166        # schema        # schema
167        my $schema;        my $schema;
168        my $evalstr = '$schema = $' . $_ . '::schema;';        my $evalstr = '$schema = $' . $_ . '::schema;';
169        my $res = eval($evalstr);        my $res = eval($evalstr);
       use Data::Dumper;  
170        push @classes, $schema;        push @classes, $schema;
171      } @{$classlist};      } @{$classlist};
172    
173        # build up the schema as a hash
174        my $schema = {
175          classes => \@classes,
176        };
177        
178        # merge schema properties
179        foreach (keys %$schema_properties) {
180          $schema->{$_} = $schema_properties->{$_};
181        }
182        
183      # create a new Tangram schema object      # create a new Tangram schema object
184      # these classes must occour in the same order used at a previous setup      # a) these classes must occour in the same order used at a previous setup or
185      $self->{schema} = Tangram::Schema->new({ classes => \@classes });          # b) better use class ids!
186        $self->{schema} = Tangram::Schema->new($schema);
187      return 1;      return 1;
188            
189    =pod
190      # ======================================      # ======================================
191      # template      # schema template
192      $self->{schema} = Tangram::Schema->new({      $self->{schema} = Tangram::Schema->new({
193    
194          classes => [          classes => [
       
195            # misc            # misc
196              'SystemEvent' => $SystemEvent::schema,              'Person' => $Person::schema,
       
197          ],          ],
198    
199            make_object => sub { ... },
200            set_id => sub { ... }
201            get_id => sub { ... }
202            normalize => sub { ... },
203    
204            control => '...'
205    
206            sql => { ... },
207    
208        });        });
209      # ======================================      # ======================================
210    =cut
211    
212    }    }
213        
# Line 162  package Data::Storage::Schema::Abstract; Line 222  package Data::Storage::Schema::Abstract;
222    sub getSchema {    sub getSchema {
223      my $self = shift;      my $self = shift;
224      if (!$self->{schema}) {      if (!$self->{schema}) {
225        print "schema is not yet initialized!", "\n";        #print "schema is not yet initialized!", "\n";
226        exit;        #exit;
227          $logger->error( __PACKAGE__ . "->getSchema: Schema is not yet initialized!" );
228          return;
229      }      }
230      return $self->{schema};      return $self->{schema};
231    }    }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed