/[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.4 by joko, Fri Nov 15 13:21:39 2002 UTC revision 1.7 by joko, Mon Dec 16 06:45:07 2002 UTC
# Line 1  Line 1 
1  ###############################################  ## ------------------------------------------------------------------------
2  #  ##  $Id$
3  #  $Id$  ## ------------------------------------------------------------------------
4  #  ##  $Log$
5  #  $Log$  ##  Revision 1.7  2002/12/16 06:45:07  joko
6  #  Revision 1.4  2002/11/15 13:21:39  joko  ##  + injecting property 'guid' into each conrete class when initializing the schema
7  #  + added capability to propagate global schema options from schema module to tangram schema  ##
8  #  ##  Revision 1.6  2002/11/17 07:21:47  jonen
9  #  Revision 1.3  2002/11/09 01:27:23  joko  ##  + using Class::Tangram::import_schema() again for proper usage of its helper functions
10  #  + dependency of Class::Tangram now is 1.13 at minimum  ##
11  #  ##  Revision 1.5  2002/11/17 07:12:06  joko
12  #  Revision 1.2  2002/10/25 11:45:10  joko  ##  + extended ::getProperties with argument "want_transactions"
13  #  + enhanced robustness  ##
14  #  + more logging for debug-levels  ##  Revision 1.4  2002/11/15 13:21:39  joko
15  #  ##  + added capability to propagate global schema options from schema module to tangram schema
16  #  Revision 1.1  2002/10/17 00:07:14  joko  ##
17  #  + new  ##  Revision 1.3  2002/11/09 01:27:23  joko
18  #  ##  + dependency of Class::Tangram now is 1.13 at minimum
19  #  ##
20  ###############################################  ##  Revision 1.2  2002/10/25 11:45:10  joko
21    ##  + enhanced robustness
22    ##  + more logging for debug-levels
23    ##
24    ##  Revision 1.1  2002/10/17 00:07:14  joko
25    ##  + new
26    ## ------------------------------------------------------------------------
27                                                
28  # ====================================  
29  package Data::Storage::Schema::Abstract;  package Data::Storage::Schema::Abstract;
30    
31    use strict;  use strict;
32    use warnings;  use warnings;
     
   use Tangram;  
   use Class::Tangram;  
     
   use Tangram::RawDate;  
   use Tangram::RawTime;  
   use Tangram::RawDateTime;  
33        
34    use Tangram::FlatArray;  use Tangram;
35    use Tangram::FlatHash;  use Class::Tangram;
36    use Tangram::PerlDump;  
37      use Tangram::RawDate;
38    # get logger instance  use Tangram::RawTime;
39    my $logger = Log::Dispatch::Config->instance;  use Tangram::RawDateTime;
40    
41    use Tangram::FlatArray;
42    use Tangram::FlatHash;
43    use Tangram::PerlDump;
44    
45    
46    use Data::Dumper;
47    
48    # get logger instance
49    my $logger = Log::Dispatch::Config->instance;
50    
51    
52    
53  # ========   object constructor - %args to $self  ========  # ========   object constructor - %args to $self  ========
# Line 47  package Data::Storage::Schema::Abstract; Line 57  package Data::Storage::Schema::Abstract;
57      my @args = ();      my @args = ();
58      @_ && (@args = @_);      @_ && (@args = @_);
59            
60        $logger->debug( __PACKAGE__ . "->new" );
61    
62      #my $self = { @_ };      #my $self = { @_ };
63    
64      # 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 55  package Data::Storage::Schema::Abstract; Line 67  package Data::Storage::Schema::Abstract;
67      # make hash from array      # make hash from array
68      my %args = @args_all;      my %args = @args_all;
69    
70      $logger->debug( __PACKAGE__ . "->new( @args_all )" );      #$logger->debug( __PACKAGE__ . "->new( @args_all )" );
71            
72      my $self = { %args };      my $self = { %args };
73      bless $self, $class;      bless $self, $class;
74    
75        #use Data::Dumper; print Dumper($self);
76    
77      # remember as which Class we are instantiated      # remember as which Class we are instantiated
78      $self->{invocant} = $invocant;      $self->{invocant} = $invocant;
79    
# Line 141  package Data::Storage::Schema::Abstract; Line 155  package Data::Storage::Schema::Abstract;
155            
156      my $schema_properties = {};      my $schema_properties = {};
157      if ($self->{invocant}->can('getProperties')) {      if ($self->{invocant}->can('getProperties')) {
158        $schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');        # TODO: rework this! call by ref and/or do oo
159          #$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');
160          $schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');
161      }      }
162            
163        # build temporary index to look up class by classname
164        my $classindex = {};
165        
166      # build argument to be passed to "Tangram::Schema->new(...)"      # build argument to be passed to "Tangram::Schema->new(...)"
167      my @classes;      my @classes;
168      map {      map {
169        $logger->debug( __PACKAGE__ . "->_doinit: Initializing Class $_" );        $logger->debug( __PACKAGE__ . "->_doinit: Initializing Class $_" );
170          Class::Tangram::import_schema($_);
171        # classname        # classname
172        push @classes, $_;        push @classes, $_;
173        # schema        # schema
# Line 155  package Data::Storage::Schema::Abstract; Line 175  package Data::Storage::Schema::Abstract;
175        my $evalstr = '$schema = $' . $_ . '::schema;';        my $evalstr = '$schema = $' . $_ . '::schema;';
176        my $res = eval($evalstr);        my $res = eval($evalstr);
177        push @classes, $schema;        push @classes, $schema;
178          $classindex->{$_} = $schema;
179      } @{$classlist};      } @{$classlist};
180    
181      # build up the schema as a hash      # build up the schema as a hash
# Line 166  package Data::Storage::Schema::Abstract; Line 187  package Data::Storage::Schema::Abstract;
187      foreach (keys %$schema_properties) {      foreach (keys %$schema_properties) {
188        $schema->{$_} = $schema_properties->{$_};        $schema->{$_} = $schema_properties->{$_};
189      }      }
190    
191    #print Dumper($schema);
192    
193        # patch guid into each concrete (non-abstract) object
194        # TODO: refactor this code into function: _injectProperty('guid')
195        foreach (@{$schema->{classes}}) {
196          my $ref = ref $_;
197          next if !$ref || $ref ne 'HASH';
198          next if $_->{abstract};
199    
200    #print Dumper($_);
201    
202          if (!$_->{fields}->{string}) {
203            $_->{fields}->{string}->{guid} = undef;
204            
205          } elsif (ref $_->{fields}->{string} eq 'ARRAY') {
206            push @{$_->{fields}->{string}}, 'guid';
207    
208          } elsif (ref $_->{fields}->{string} eq 'HASH') {
209            $_->{fields}->{string}->{guid} = undef;
210            
211          }
212        }
213            
214      # create a new Tangram schema object      # create a new Tangram schema object
215      # a) these classes must occour in the same order used at a previous setup or      # a) these classes must occour in the same order used at a previous setup or
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed