Storage/Schema/Abstract.pm

## ------------------------------------------------------------------------
##  $Id: Abstract.pm,v 1.6 2002/11/17 07:21:47 jonen Exp $
## ------------------------------------------------------------------------
##  $Log: Abstract.pm,v $
##  Revision 1.6  2002/11/17 07:21:47  jonen
##  + using Class::Tangram::import_schema() again for proper usage of its helper functions
##
##  Revision 1.5  2002/11/17 07:12:06  joko
##  + extended ::getProperties with argument "want_transactions"
##
##  Revision 1.4  2002/11/15 13:21:39  joko
##  + added capability to propagate global schema options from schema module to tangram schema
##
##  Revision 1.3  2002/11/09 01:27:23  joko
##  + dependency of Class::Tangram now is 1.13 at minimum
##
##  Revision 1.2  2002/10/25 11:45:10  joko
##  + enhanced robustness
##  + more logging for debug-levels
##
##  Revision 1.1  2002/10/17 00:07:14  joko
##  + new
## ------------------------------------------------------------------------
                       

package Data::Storage::Schema::Abstract;

use strict;
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;


use Data::Dumper;

# get logger instance
my $logger = Log::Dispatch::Config->instance;


# ========   object constructor - %args to $self  ========
  sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my @args = ();
    @_ && (@args = @_);
    
    $logger->debug( __PACKAGE__ . "->new" );

    #my $self = { @_ };

    # merge all entries from all hashes in args-array to single array (key, val, key, val)
    my @args_all = ();
    map { push(@args_all, %{$_}); } @args;
    # make hash from array
    my %args = @args_all;

    #$logger->debug( __PACKAGE__ . "->new( @args_all )" );
    
    my $self = { %args };
    bless $self, $class;

    #use Data::Dumper; print Dumper($self);

    # remember as which Class we are instantiated
    $self->{invocant} = $invocant;

    $self->_checkClassTangram();
    $self->_init();
    
    return $self;
  }
  
  sub _checkClassTangram {
    my $self = shift;
    # check version of "Class::Tangram"
    my $ctversion = $Class::Tangram::VERSION;
    #print "ctversion: ", $ctversion, "\n";
    #if ($ctversion ne 1.04) {
    if ($ctversion lt 1.13) {
      print "Version of \"Class::Tangram\": ", $ctversion, "\n";
      print "minimum required version   : ", "1.13", "\n";
      #print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";
      exit;
    }
  }

  sub _parsePackageNamesFromFile {
    my $self = shift;
    my $filename = shift;
    my $exclude_pattern = shift;
    $logger->debug( __PACKAGE__ . "->_parsePackageFile( ... )" );
    if (!$filename) {
      $logger->error( __PACKAGE__ . "->_parsePackageFile: you must specify a filename" );
      return;
    }
    if (! -e $filename) {
      $logger->error( __PACKAGE__ . "->_parsePackageFile: could not find $filename" );
    }
    my @packages = ();
    open(FH, '<' . $filename);
    while (<FH>) {
      chomp();
      my $good = 1;
      $exclude_pattern && ($good = !m/$exclude_pattern/);
      push @packages, $1 if m/^package (.+?);/ && $good;
    }
    close(FH);
    return \@packages;
  }

  sub _doinit {
    my $self = shift;
    
    $logger->debug( __PACKAGE__ . "->_doinit()" );

    # WHAT?
    # imports classes to Tangram-Schema in this style, but in an abstracted way:
    #     Class::Tangram::import_schema("SystemEvent");
    # TODO:
    # move this code to Data::Storage::Schema::Tangram

    # TODO:
    # two cases:
    # 1. use a given list of strings as to-be-used-object-names
    # 2. parse the content of the given package and use all declared Perl Packages as objects
    
    my $classlist = $self->{EXPORT_OBJECTS};
    
    # parse complete package to build list of classes
    if ($#{$classlist} == -1) {
      $logger->debug( "_doinit() Initializing all Classes from " . $self->{invocant} );
      if (!$self->{invocant}->can('getFilename')) {
        $logger->error( __PACKAGE__ . "->_doinit: Package $self->{invocant} doesn't contain method 'getFilename'" );
        return;
      }
      my $perl_packagefile = eval('return ' . $self->{invocant} . '::getFilename();');
      my $packages = $self->_parsePackageNamesFromFile($perl_packagefile, $self->{invocant});
      # TODO:
      # cache list so this routine isn't called on every startup/request
      $classlist = $packages;
    }
    
    my $schema_properties = {};
    if ($self->{invocant}->can('getProperties')) {
      # TODO: rework this! call by ref and/or do oo
      #$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');
      $schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');
    }
    
    # build temporary index to look up class by classname
    my $classindex = {};
    
    # build argument to be passed to "Tangram::Schema->new(...)"
    my @classes;
    map {
      $logger->debug( __PACKAGE__ . "->_doinit: Initializing Class $_" );
      Class::Tangram::import_schema($_);
      # classname
      push @classes, $_;
      # schema
      my $schema;
      my $evalstr = '$schema = $' . $_ . '::schema;';
      my $res = eval($evalstr);
      push @classes, $schema;
      $classindex->{$_} = $schema;
    } @{$classlist};

    # build up the schema as a hash
    my $schema = { 
      classes => \@classes,
    };
    
    # merge schema properties
    foreach (keys %$schema_properties) {
      $schema->{$_} = $schema_properties->{$_};
    }

#print Dumper($schema);

    # patch guid into each concrete (non-abstract) object
    # TODO: refactor this code into function: _injectProperty('guid')
    foreach (@{$schema->{classes}}) {
      my $ref = ref $_;
      next if !$ref || $ref ne 'HASH';
      next if $_->{abstract};

#print Dumper($_);

      if (!$_->{fields}->{string}) {
        $_->{fields}->{string}->{guid} = undef;
        
      } elsif (ref $_->{fields}->{string} eq 'ARRAY') {
        push @{$_->{fields}->{string}}, 'guid';

      } elsif (ref $_->{fields}->{string} eq 'HASH') {
        $_->{fields}->{string}->{guid} = undef;
        
      }
    }
    
    # create a new Tangram schema object
    # a) these classes must occour in the same order used at a previous setup or
    # b) better use class ids!
    $self->{schema} = Tangram::Schema->new($schema);
    return 1;
    
=pod
    # ======================================
    # schema template
    $self->{schema} = Tangram::Schema->new({ 

        classes => [ 
          # misc
            'Person' => $Person::schema,
        ],

        make_object => sub { ... },
        set_id => sub { ... }
        get_id => sub { ... }
        normalize => sub { ... },

        control => '...'

        sql => { ... },

      });
    # ======================================
=cut

  }
  
  sub _init {
    my $self = shift;
    if (!$self->{schema}) {
      $self->_doinit();
    }
  }

  # return schema
  sub getSchema {
    my $self = shift;
    if (!$self->{schema}) {
      #print "schema is not yet initialized!", "\n";
      #exit;
      $logger->error( __PACKAGE__ . "->getSchema: Schema is not yet initialized!" );
      return;
    }
    return $self->{schema};
  }


1;
1	joko	1.7	## ------------------------------------------------------------------------
2			## $Id: Abstract.pm,v 1.6 2002/11/17 07:21:47 jonen Exp $
3			## ------------------------------------------------------------------------
4			## $Log: Abstract.pm,v $
5			## Revision 1.6 2002/11/17 07:21:47 jonen
6			## + using Class::Tangram::import_schema() again for proper usage of its helper functions
7			##
8			## Revision 1.5 2002/11/17 07:12:06 joko
9			## + extended ::getProperties with argument "want_transactions"
10			##
11			## Revision 1.4 2002/11/15 13:21:39 joko
12			## + added capability to propagate global schema options from schema module to tangram schema
13			##
14			## Revision 1.3 2002/11/09 01:27:23 joko
15			## + dependency of Class::Tangram now is 1.13 at minimum
16			##
17			## Revision 1.2 2002/10/25 11:45:10 joko
18			## + enhanced robustness
19			## + more logging for debug-levels
20			##
21			## Revision 1.1 2002/10/17 00:07:14 joko
22			## + new
23			## ------------------------------------------------------------------------
24	joko	1.1
25	joko	1.7
26	joko	1.1	package Data::Storage::Schema::Abstract;
27
28	joko	1.7	use strict;
29			use warnings;
30	joko	1.1
31	joko	1.7	use Tangram;
32			use Class::Tangram;
33
34			use Tangram::RawDate;
35			use Tangram::RawTime;
36			use Tangram::RawDateTime;
37
38			use Tangram::FlatArray;
39			use Tangram::FlatHash;
40			use Tangram::PerlDump;
41
42
43			use Data::Dumper;
44
45			# get logger instance
46			my $logger = Log::Dispatch::Config->instance;
47
48	joko	1.1
49
50			# ======== object constructor - %args to $self ========
51			sub new {
52			my $invocant = shift;
53			my $class = ref($invocant) \|\| $invocant;
54			my @args = ();
55			@_ && (@args = @_);
56	joko	1.2
57	joko	1.5	$logger->debug( __PACKAGE__ . "->new" );
58
59	joko	1.1	#my $self = { @_ };
60
61			# merge all entries from all hashes in args-array to single array (key, val, key, val)
62			my @args_all = ();
63			map { push(@args_all, %{$_}); } @args;
64			# make hash from array
65			my %args = @args_all;
66	joko	1.2
67	joko	1.5	#$logger->debug( __PACKAGE__ . "->new( @args_all )" );
68	joko	1.1
69			my $self = { %args };
70			bless $self, $class;
71
72	joko	1.5	#use Data::Dumper; print Dumper($self);
73
74	joko	1.1	# remember as which Class we are instantiated
75			$self->{invocant} = $invocant;
76
77			$self->_checkClassTangram();
78			$self->_init();
79
80			return $self;
81			}
82
83			sub _checkClassTangram {
84			my $self = shift;
85			# check version of "Class::Tangram"
86			my $ctversion = $Class::Tangram::VERSION;
87			#print "ctversion: ", $ctversion, "\n";
88			#if ($ctversion ne 1.04) {
89	joko	1.3	if ($ctversion lt 1.13) {
90	joko	1.1	print "Version of \"Class::Tangram\": ", $ctversion, "\n";
91	joko	1.3	print "minimum required version : ", "1.13", "\n";
92	joko	1.1	#print "quitting!!! (please install older version (1.04) of \"Class::Tangram\"", "\n";
93			exit;
94			}
95			}
96
97			sub _parsePackageNamesFromFile {
98			my $self = shift;
99			my $filename = shift;
100			my $exclude_pattern = shift;
101			$logger->debug( __PACKAGE__ . "->_parsePackageFile( ... )" );
102	joko	1.2	if (!$filename) {
103			$logger->error( __PACKAGE__ . "->_parsePackageFile: you must specify a filename" );
104			return;
105			}
106			if (! -e $filename) {
107			$logger->error( __PACKAGE__ . "->_parsePackageFile: could not find $filename" );
108			}
109	joko	1.1	my @packages = ();
110			open(FH, '<' . $filename);
111			while (<FH>) {
112			chomp();
113			my $good = 1;
114			$exclude_pattern && ($good = !m/$exclude_pattern/);
115			push @packages, $1 if m/^package (.+?);/ && $good;
116			}
117			close(FH);
118			return \@packages;
119			}
120
121			sub _doinit {
122			my $self = shift;
123
124			$logger->debug( __PACKAGE__ . "->_doinit()" );
125
126			# WHAT?
127			# imports classes to Tangram-Schema in this style, but in an abstracted way:
128			# Class::Tangram::import_schema("SystemEvent");
129			# TODO:
130			# move this code to Data::Storage::Schema::Tangram
131
132			# TODO:
133			# two cases:
134			# 1. use a given list of strings as to-be-used-object-names
135			# 2. parse the content of the given package and use all declared Perl Packages as objects
136
137			my $classlist = $self->{EXPORT_OBJECTS};
138
139			# parse complete package to build list of classes
140			if ($#{$classlist} == -1) {
141			$logger->debug( "_doinit() Initializing all Classes from " . $self->{invocant} );
142	joko	1.2	if (!$self->{invocant}->can('getFilename')) {
143			$logger->error( __PACKAGE__ . "->_doinit: Package $self->{invocant} doesn't contain method 'getFilename'" );
144			return;
145			}
146	joko	1.1	my $perl_packagefile = eval('return ' . $self->{invocant} . '::getFilename();');
147			my $packages = $self->_parsePackageNamesFromFile($perl_packagefile, $self->{invocant});
148			# TODO:
149			# cache list so this routine isn't called on every startup/request
150			$classlist = $packages;
151			}
152
153	joko	1.4	my $schema_properties = {};
154			if ($self->{invocant}->can('getProperties')) {
155	joko	1.5	# TODO: rework this! call by ref and/or do oo
156			#$schema_properties = eval('return ' . $self->{invocant} . '::getProperties();');
157			$schema_properties = eval('return ' . $self->{invocant} . '::getProperties($self->{want_transactions});');
158	joko	1.4	}
159
160	joko	1.7	# build temporary index to look up class by classname
161			my $classindex = {};
162
163	joko	1.1	# build argument to be passed to "Tangram::Schema->new(...)"
164			my @classes;
165			map {
166	joko	1.2	$logger->debug( __PACKAGE__ . "->_doinit: Initializing Class $_" );
167	jonen	1.6	Class::Tangram::import_schema($_);
168	joko	1.1	# classname
169			push @classes, $_;
170			# schema
171			my $schema;
172			my $evalstr = '$schema = $' . $_ . '::schema;';
173			my $res = eval($evalstr);
174			push @classes, $schema;
175	joko	1.7	$classindex->{$_} = $schema;
176	joko	1.1	} @{$classlist};
177
178	joko	1.4	# build up the schema as a hash
179			my $schema = {
180			classes => \@classes,
181			};
182
183			# merge schema properties
184			foreach (keys %$schema_properties) {
185			$schema->{$_} = $schema_properties->{$_};
186	joko	1.7	}
187
188			#print Dumper($schema);
189
190			# patch guid into each concrete (non-abstract) object
191			# TODO: refactor this code into function: _injectProperty('guid')
192			foreach (@{$schema->{classes}}) {
193			my $ref = ref $_;
194			next if !$ref \|\| $ref ne 'HASH';
195			next if $_->{abstract};
196
197			#print Dumper($_);
198
199			if (!$_->{fields}->{string}) {
200			$_->{fields}->{string}->{guid} = undef;
201
202			} elsif (ref $_->{fields}->{string} eq 'ARRAY') {
203			push @{$_->{fields}->{string}}, 'guid';
204
205			} elsif (ref $_->{fields}->{string} eq 'HASH') {
206			$_->{fields}->{string}->{guid} = undef;
207
208			}
209	joko	1.4	}
210
211	joko	1.1	# create a new Tangram schema object
212	joko	1.4	# a) these classes must occour in the same order used at a previous setup or
213			# b) better use class ids!
214			$self->{schema} = Tangram::Schema->new($schema);
215	joko	1.1	return 1;
216
217	joko	1.4	=pod
218	joko	1.1	# ======================================
219	joko	1.4	# schema template
220	joko	1.1	$self->{schema} = Tangram::Schema->new({
221	joko	1.4
222	joko	1.1	classes => [
223			# misc
224	joko	1.4	'Person' => $Person::schema,
225	joko	1.1	],
226	joko	1.4
227			make_object => sub { ... },
228			set_id => sub { ... }
229			get_id => sub { ... }
230			normalize => sub { ... },
231
232			control => '...'
233
234			sql => { ... },
235
236	joko	1.1	});
237			# ======================================
238	joko	1.4	=cut
239	joko	1.1
240			}
241
242			sub _init {
243			my $self = shift;
244			if (!$self->{schema}) {
245			$self->_doinit();
246			}
247			}
248
249			# return schema
250			sub getSchema {
251			my $self = shift;
252			if (!$self->{schema}) {
253	joko	1.2	#print "schema is not yet initialized!", "\n";
254			#exit;
255			$logger->error( __PACKAGE__ . "->getSchema: Schema is not yet initialized!" );
256			return;
257	joko	1.1	}
258			return $self->{schema};
259			}
260
261
262			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26