Storage/Schema/Abstract.pm

###############################################
#
#  $Id: Abstract.pm,v 1.1 2002/10/17 00:07:14 joko Exp $
#
#  $Log: Abstract.pm,v $
#  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 ne 1.12) {
      print "Version of \"Class::Tangram\": ", $ctversion, "\n";
      print "absolutely required version: ", "1.12", "\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;
    }
    
    # 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};

    # create a new Tangram schema object
    # these classes must occour in the same order used at a previous setup
    $self->{schema} = Tangram::Schema->new({ classes => \@classes });    
    return 1;
    
    # ======================================
    # template
    $self->{schema} = Tangram::Schema->new({ 
        classes => [ 
    
          # misc
            'SystemEvent' => $SystemEvent::schema,
    
        ],
      });
    # ======================================


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