Storage/Schema/Abstract.pm

###############################################
#
#  $Id: Abstract.pm,v 1.3 2002/11/09 01:27:23 joko Exp $
#
#  $Log: Abstract.pm,v $
#  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 = @_);
    
    #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;

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