/[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.2 by joko, Fri Oct 25 11:45:10 2002 UTC revision 1.5 by joko, Sun Nov 17 07:12:06 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.5  2002/11/17 07:12:06  joko
7    #  + extended ::getProperties with argument "want_transactions"
8    #
9    #  Revision 1.4  2002/11/15 13:21:39  joko
10    #  + added capability to propagate global schema options from schema module to tangram schema
11    #
12    #  Revision 1.3  2002/11/09 01:27:23  joko
13    #  + dependency of Class::Tangram now is 1.13 at minimum
14    #
15  #  Revision 1.2  2002/10/25 11:45:10  joko  #  Revision 1.2  2002/10/25 11:45:10  joko
16  #  + enhanced robustness  #  + enhanced robustness
17  #  + more logging for debug-levels  #  + more logging for debug-levels
# Line 41  package Data::Storage::Schema::Abstract; Line 50  package Data::Storage::Schema::Abstract;
50      my @args = ();      my @args = ();
51      @_ && (@args = @_);      @_ && (@args = @_);
52            
53        $logger->debug( __PACKAGE__ . "->new" );
54    
55      #my $self = { @_ };      #my $self = { @_ };
56    
57      # 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 49  package Data::Storage::Schema::Abstract; Line 60  package Data::Storage::Schema::Abstract;
60      # make hash from array      # make hash from array
61      my %args = @args_all;      my %args = @args_all;
62    
63      $logger->debug( __PACKAGE__ . "->new( @args_all )" );      #$logger->debug( __PACKAGE__ . "->new( @args_all )" );
64            
65      my $self = { %args };      my $self = { %args };
66      bless $self, $class;      bless $self, $class;
67    
68        #use Data::Dumper; print Dumper($self);
69    
70      # remember as which Class we are instantiated      # remember as which Class we are instantiated
71      $self->{invocant} = $invocant;      $self->{invocant} = $invocant;
72    
# Line 69  package Data::Storage::Schema::Abstract; Line 82  package Data::Storage::Schema::Abstract;
82      my $ctversion = $Class::Tangram::VERSION;      my $ctversion = $Class::Tangram::VERSION;
83      #print "ctversion: ", $ctversion, "\n";      #print "ctversion: ", $ctversion, "\n";
84      #if ($ctversion ne 1.04) {      #if ($ctversion ne 1.04) {
85      if ($ctversion ne 1.12) {      if ($ctversion lt 1.13) {
86        print "Version of \"Class::Tangram\": ", $ctversion, "\n";        print "Version of \"Class::Tangram\": ", $ctversion, "\n";
87        print "absolutely required version: ", "1.12", "\n";        print "minimum required version   : ", "1.13", "\n";
88        #print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";        #print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";
89        exit;        exit;
90      }      }
# Line 133  package Data::Storage::Schema::Abstract; Line 146  package Data::Storage::Schema::Abstract;
146        $classlist = $packages;        $classlist = $packages;
147      }      }
148            
149        my $schema_properties = {};
150        if ($self->{invocant}->can('getProperties')) {
151          # TODO: rework this! call by ref and/or do oo
152          #$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');
153          $schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');
154        }
155        
156      # build argument to be passed to "Tangram::Schema->new(...)"      # build argument to be passed to "Tangram::Schema->new(...)"
157      my @classes;      my @classes;
158      map {      map {
# Line 146  package Data::Storage::Schema::Abstract; Line 166  package Data::Storage::Schema::Abstract;
166        push @classes, $schema;        push @classes, $schema;
167      } @{$classlist};      } @{$classlist};
168    
169        # build up the schema as a hash
170        my $schema = {
171          classes => \@classes,
172        };
173        
174        # merge schema properties
175        foreach (keys %$schema_properties) {
176          $schema->{$_} = $schema_properties->{$_};
177        }
178        
179      # create a new Tangram schema object      # create a new Tangram schema object
180      # 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
181      $self->{schema} = Tangram::Schema->new({ classes => \@classes });          # b) better use class ids!
182        $self->{schema} = Tangram::Schema->new($schema);
183      return 1;      return 1;
184            
185    =pod
186      # ======================================      # ======================================
187      # template      # schema template
188      $self->{schema} = Tangram::Schema->new({      $self->{schema} = Tangram::Schema->new({
189    
190          classes => [          classes => [
       
191            # misc            # misc
192              'SystemEvent' => $SystemEvent::schema,              'Person' => $Person::schema,
       
193          ],          ],
194    
195            make_object => sub { ... },
196            set_id => sub { ... }
197            get_id => sub { ... }
198            normalize => sub { ... },
199    
200            control => '...'
201    
202            sql => { ... },
203    
204        });        });
205      # ======================================      # ======================================
206    =cut
207    
208    }    }
209        

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed