Storage/Schema/Abstract.pm

###############################################
#
#  $Id: Abstract.pm,v 1.5 2002/11/17 07:12:06 joko Exp $
#
#  $Log: Abstract.pm,v $
#  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;
  
  # 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 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;
    } @{$classlist};

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