/[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.3 by joko, Sat Nov 9 01:27:23 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.3  2002/11/09 01:27:23  joko  ##  + injecting property 'guid' into each conrete class when initializing the schema
7  #  + dependency of Class::Tangram now is 1.13 at minimum  ##
8  #  ##  Revision 1.6  2002/11/17 07:21:47  jonen
9  #  Revision 1.2  2002/10/25 11:45:10  joko  ##  + using Class::Tangram::import_schema() again for proper usage of its helper functions
10  #  + enhanced robustness  ##
11  #  + more logging for debug-levels  ##  Revision 1.5  2002/11/17 07:12:06  joko
12  #  ##  + extended ::getProperties with argument "want_transactions"
13  #  Revision 1.1  2002/10/17 00:07:14  joko  ##
14  #  + new  ##  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  #  ##
17  ###############################################  ##  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;  
     
   use Tangram::FlatArray;  
   use Tangram::FlatHash;  
   use Tangram::PerlDump;  
33        
34    # get logger instance  use Tangram;
35    my $logger = Log::Dispatch::Config->instance;  use Class::Tangram;
36    
37    use Tangram::RawDate;
38    use Tangram::RawTime;
39    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 44  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 52  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 136  package Data::Storage::Schema::Abstract; Line 153  package Data::Storage::Schema::Abstract;
153        $classlist = $packages;        $classlist = $packages;
154      }      }
155            
156        my $schema_properties = {};
157        if ($self->{invocant}->can('getProperties')) {
158          # 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 147  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
182        my $schema = {
183          classes => \@classes,
184        };
185        
186        # merge schema properties
187        foreach (keys %$schema_properties) {
188          $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      # 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
216      $self->{schema} = Tangram::Schema->new({ classes => \@classes });          # b) better use class ids!
217        $self->{schema} = Tangram::Schema->new($schema);
218      return 1;      return 1;
219            
220    =pod
221      # ======================================      # ======================================
222      # template      # schema template
223      $self->{schema} = Tangram::Schema->new({      $self->{schema} = Tangram::Schema->new({
224    
225          classes => [          classes => [
       
226            # misc            # misc
227              'SystemEvent' => $SystemEvent::schema,              'Person' => $Person::schema,
       
228          ],          ],
229    
230            make_object => sub { ... },
231            set_id => sub { ... }
232            get_id => sub { ... }
233            normalize => sub { ... },
234    
235            control => '...'
236    
237            sql => { ... },
238    
239        });        });
240      # ======================================      # ======================================
241    =cut
242    
243    }    }
244        
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed