/[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.6 by jonen, Sun Nov 17 07:21:47 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.6  2002/11/17 07:21:47  jonen  ##  + injecting property 'guid' into each conrete class when initializing the schema
7  #  + using Class::Tangram::import_schema() again for proper usage of its helper functions  ##
8  #  ##  Revision 1.6  2002/11/17 07:21:47  jonen
9  #  Revision 1.5  2002/11/17 07:12:06  joko  ##  + using Class::Tangram::import_schema() again for proper usage of its helper functions
10  #  + extended ::getProperties with argument "want_transactions"  ##
11  #  ##  Revision 1.5  2002/11/17 07:12:06  joko
12  #  Revision 1.4  2002/11/15 13:21:39  joko  ##  + extended ::getProperties with argument "want_transactions"
13  #  + added capability to propagate global schema options from schema module to tangram schema  ##
14  #  ##  Revision 1.4  2002/11/15 13:21:39  joko
15  #  Revision 1.3  2002/11/09 01:27:23  joko  ##  + added capability to propagate global schema options from schema module to tangram schema
16  #  + dependency of Class::Tangram now is 1.13 at minimum  ##
17  #  ##  Revision 1.3  2002/11/09 01:27:23  joko
18  #  Revision 1.2  2002/10/25 11:45:10  joko  ##  + dependency of Class::Tangram now is 1.13 at minimum
19  #  + enhanced robustness  ##
20  #  + more logging for debug-levels  ##  Revision 1.2  2002/10/25 11:45:10  joko
21  #  ##  + enhanced robustness
22  #  Revision 1.1  2002/10/17 00:07:14  joko  ##  + more logging for debug-levels
23  #  + new  ##
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 156  package Data::Storage::Schema::Abstract; Line 160  package Data::Storage::Schema::Abstract;
160        $schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');        $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 {
# Line 168  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 179  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.6  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed