libs/Data/Storage.pm

## ------------------------------------------------------------------------
##
##    $Id: Storage.pm,v 1.19 2003/02/18 19:22:11 joko Exp $
##
##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
##
##    See COPYRIGHT section in pod text below for usage and distribution rights.
##
## ------------------------------------------------------------------------
##
##  $Log: Storage.pm,v $
##  Revision 1.19  2003/02/18 19:22:11  joko
##  + fixed logging
##
##  Revision 1.18  2003/01/30 22:12:17  joko
##  - removed/refactored old code: ->Data::Storage::Handler::Tangram|DBI
##
##  Revision 1.17  2003/01/30 21:42:22  joko
##  + minor update: renamed method
##
##  Revision 1.16  2003/01/20 16:52:13  joko
##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
##
##  Revision 1.15  2003/01/19 03:12:59  joko
##  + modified header
##  - removed pod-documentation - now in 'Storage.pod'
##
##  Revision 1.14  2002/12/19 16:27:59  joko
##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
##
##  Revision 1.13  2002/12/17 21:54:12  joko
##  + feature when using Tangram:
##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
##        + patched Tangram::Storage (jonen)
##        + enhanced Data::Storage::Schema::Tangram (joko)
##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
##    + how?
##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
##
##  Revision 1.12  2002/12/12 02:50:15  joko
##  + this now (unfortunately) needs DBI for some helper functions
##  + TODO: these have to be refactored to another scope! (soon!)
##
##  Revision 1.11  2002/12/11 06:53:19  joko
##  + updated pod
##
##  Revision 1.10  2002/12/07 03:37:23  joko
##  + updated pod
##
##  Revision 1.9  2002/12/01 22:15:45  joko
##  - sub createDb: moved to handler
##
##  Revision 1.8  2002/11/29 04:48:23  joko
##  + updated pod
##
##  Revision 1.7  2002/11/17 06:07:18  joko
##  + creating the handler is easier than proposed first - for now :-)
##  + sub testAvailability
##
##  Revision 1.6  2002/11/09 01:04:58  joko
##  + updated pod
##
##  Revision 1.5  2002/10/29 19:24:18  joko
##  - reduced logging
##  + added some pod
##
##  Revision 1.4  2002/10/27 18:35:07  joko
##  + added pod
##
##  Revision 1.3  2002/10/25 11:40:37  joko
##  + enhanced robustness
##  + more logging for debug-levels
##  + sub dropDb
##
##  Revision 1.2  2002/10/17 00:04:29  joko
##  + sub createDb
##  + sub isConnected
##  + bugfixes regarding "deep recursion" stuff
##
##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
##  + new
## ------------------------------------------------------------------------


BEGIN {
  $Data::Storage::VERSION = 0.03;
}

package Data::Storage;

use strict;
use warnings;

use Data::Dumper;
# FIXME: wipe out!
use DBI;

use Data::Storage::Locator;
use DesignPattern::Object;


# TODO: actually implement level (integrate with Log::Dispatch)
my $TRACELEVEL = 0;

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

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  #my @args = normalizeArgs(@_);

  my $arg_locator = shift;
  my $arg_options = shift;
  #my @args = @_;
  #@args ||= ();

  if (!$arg_locator) {
    $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
    return;
  }
  
  #print Dumper($arg_locator);

  #my $self = { STORAGEHANDLE => undef, @_ };
  my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
  #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
  $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new()" );
  return bless $self, $class;
}

sub AUTOLOAD {
  
  # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
  # some sophisticated handling and filtering is needed to avoid things like
  #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
  #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
  #     - Deep recursion on anonymous subroutine at [...]
  # we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
  
  my $self = shift;
  our $AUTOLOAD;
  
  # ->DESTROY would - if not declared - trigger an AUTOLOAD also
  return if $AUTOLOAD =~ m/::DESTROY$/;

  my $method = $AUTOLOAD;
  $method =~ s/^.*:://;

  #print __PACKAGE__, "\n";
  #print $method, "\n";
  #print $self->{locator}, "\n";
  
  my $locator_type = $self->get_locator_type();

  # advanced logging of AUTOLOAD calls ...
  # ... nice but do it only when TRACING (TODO) is enabled
      my $logstring = "";
      $logstring .= __PACKAGE__ . "[$locator_type]" . "->" . $method;
      #print "count: ", $#_, "\n";
      #$logstring .= Dumper(@_) if ($#_ != -1);
      my $tabcount = int( (80 - length($logstring)) / 10 );
      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
      # TODO: only ok if logstring doesn't contain 
      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
      # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
    if ($TRACELEVEL) {
      $logger->debug( $logstring );
      #print join('; ', @_);
    }
    
  # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
  if ($self->_filter_AUTOLOAD($method)) {
    #print "=== FILTER!", "\n";
    $self->_accessStorageHandle();
    if ($self->{STORAGEHANDLE}) {
      return $self->{STORAGEHANDLE}->$method(@_);
    } else {
      my $msg = __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring;
      $logger->critical( $msg ) if $logger;
      print STDERR $msg if not $logger;
      return;
    }
  }
  
}

sub _filter_AUTOLOAD {
  my $self = shift;
  my $method = shift;
  if ($self->{options}->{protected}) {
    if ($method eq 'disconnect') {
      return;
    }
  }
  return 1;
}


sub _accessStorageHandle {
  my $self = shift;
  # TODO: to some tracelevel!
  #print "=========== _accessStorage", "\n";
  if ($TRACELEVEL) {
    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorageHandle()" );
  }
  if (!$self->{STORAGEHANDLE}) {
    return $self->_createStorageHandle();
  }
}

sub _createStorageHandle1 {
  my $self = shift;
  my $type = $self->{locator}->{type};
  $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );

  my $pkg = "Data::Storage::Handler::" . $type . "";
  
  # try to load perl module at runtime
  my $evalstr = "use $pkg;";
  eval($evalstr);
  if ($@) {
    $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
    return;
  }
  
  # build up some additional arguments to pass on
  #my @args = %{$self->{locator}};
  my @args = ();

  # - create new storage handle object
  # - propagate arguments to handler
  # - pass locator by reference to be able to store status- or meta-information in it
  $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );

}

sub _createStorageHandle {
  my $self = shift;
  
  # 2003-06-18: protection against storagehandles w/o locators
  return if not defined $self->{locator};
  
  my $type = $self->get_locator_type();
  $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );

#print Dumper($self);
#exit;

  my $pkg = "Data::Storage::Handler::" . $type . "";
  
  # try to load perl module at runtime
=pod
  my $evalstr = "use $pkg;";
  eval($evalstr);
  if ($@) {
    $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
    return;
  }
  
  # build up some additional arguments to pass on
  #my @args = %{$self->{locator}};
  my @args = ();

  # - create new storage handle object
  # - propagate arguments to handler
  # - pass locator by reference to be able to store status- or meta-information in it
  $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
=cut

  $self->{STORAGEHANDLE} = DesignPattern::Object->fromPackage( $pkg, locator => $self->{locator} );
  return 1;

}

sub addLogDispatchHandler {

      my $self = shift;
      my $name = shift;
      my $package = shift;
      my $logger1 = shift;
      my $objectCreator = shift;
      
      #$logger->add( Log::Dispatch::Tangram->new( name => $name,
      $logger->add( $package->new( name => $name,
                                            #min_level => 'debug',
                                            min_level => 'info',
                                            storage => $self,
                                            objectCreator => $objectCreator,
                                            fields => {
                                              message => 'usermsg',
                                              timestamp => 'stamp',
                                              level => 'level',
                                              name => 'code',
                                            },
                                            filter_patterns => [ '->insert\(SystemEvent=' ],
                                            #filter_patterns => [ 'SystemEvent' ],
                                            
                                            #format  => '[%d] [%p] %m%n',
                                             ) );

}

sub removeLogDispatchHandler {
  my $self = shift;
  my $name = shift;
  #my $logger = shift;
  $logger->remove($name);
}

sub get_locator_type {
  my $self = shift;
  my $locator_type = '';
  $locator_type = $self->{locator}->{type} if defined $self->{locator};
  return $locator_type;
}

1;
__END__
1	joko	1.15	## ------------------------------------------------------------------------
2			##
3	joko	1.20	## $Id: Storage.pm,v 1.19 2003/02/18 19:22:11 joko Exp $
4	joko	1.15	##
5			## Copyright (c) 2002 Andreas Motl <andreas.motl@ilo.de>
6			##
7			## See COPYRIGHT section in pod text below for usage and distribution rights.
8			##
9			## ------------------------------------------------------------------------
10			##
11			## $Log: Storage.pm,v $
12	joko	1.20	## Revision 1.19 2003/02/18 19:22:11 joko
13			## + fixed logging
14			##
15	joko	1.19	## Revision 1.18 2003/01/30 22:12:17 joko
16			## - removed/refactored old code: ->Data::Storage::Handler::Tangram\|DBI
17			##
18	joko	1.18	## Revision 1.17 2003/01/30 21:42:22 joko
19			## + minor update: renamed method
20			##
21	joko	1.17	## Revision 1.16 2003/01/20 16:52:13 joko
22			## + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
23			##
24	joko	1.16	## Revision 1.15 2003/01/19 03:12:59 joko
25			## + modified header
26			## - removed pod-documentation - now in 'Storage.pod'
27			##
28	joko	1.15	## Revision 1.14 2002/12/19 16:27:59 joko
29			## - moved 'sub dropDb' to Data::Storage::Handler::DBI
30			##
31			## Revision 1.13 2002/12/17 21:54:12 joko
32			## + feature when using Tangram:
33			## + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
34			## + patched Tangram::Storage (jonen)
35			## + enhanced Data::Storage::Schema::Tangram (joko)
36			## + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
37			## + how?
38			## + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
39			## + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
40			## + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
41			##
42			## Revision 1.12 2002/12/12 02:50:15 joko
43			## + this now (unfortunately) needs DBI for some helper functions
44			## + TODO: these have to be refactored to another scope! (soon!)
45			##
46			## Revision 1.11 2002/12/11 06:53:19 joko
47			## + updated pod
48			##
49			## Revision 1.10 2002/12/07 03:37:23 joko
50			## + updated pod
51			##
52			## Revision 1.9 2002/12/01 22:15:45 joko
53			## - sub createDb: moved to handler
54			##
55			## Revision 1.8 2002/11/29 04:48:23 joko
56			## + updated pod
57			##
58			## Revision 1.7 2002/11/17 06:07:18 joko
59			## + creating the handler is easier than proposed first - for now :-)
60			## + sub testAvailability
61			##
62			## Revision 1.6 2002/11/09 01:04:58 joko
63			## + updated pod
64			##
65			## Revision 1.5 2002/10/29 19:24:18 joko
66			## - reduced logging
67			## + added some pod
68			##
69			## Revision 1.4 2002/10/27 18:35:07 joko
70			## + added pod
71			##
72			## Revision 1.3 2002/10/25 11:40:37 joko
73			## + enhanced robustness
74			## + more logging for debug-levels
75			## + sub dropDb
76			##
77			## Revision 1.2 2002/10/17 00:04:29 joko
78			## + sub createDb
79			## + sub isConnected
80			## + bugfixes regarding "deep recursion" stuff
81			##
82			## Revision 1.1 2002/10/10 03:43:12 cvsjoko
83			## + new
84			## ------------------------------------------------------------------------
85	cvsjoko	1.1
86	joko	1.3
87	joko	1.4	BEGIN {
88	joko	1.15	$Data::Storage::VERSION = 0.03;
89	joko	1.4	}
90
91	cvsjoko	1.1	package Data::Storage;
92
93			use strict;
94			use warnings;
95
96	joko	1.16	use Data::Dumper;
97			# FIXME: wipe out!
98			use DBI;
99
100	cvsjoko	1.1	use Data::Storage::Locator;
101	joko	1.16	use DesignPattern::Object;
102	cvsjoko	1.1
103	joko	1.12
104	joko	1.6	# TODO: actually implement level (integrate with Log::Dispatch)
105	joko	1.5	my $TRACELEVEL = 0;
106
107	cvsjoko	1.1	# get logger instance
108			my $logger = Log::Dispatch::Config->instance;
109
110			sub new {
111			my $invocant = shift;
112			my $class = ref($invocant) \|\| $invocant;
113			#my @args = normalizeArgs(@_);
114	joko	1.7
115	cvsjoko	1.1	my $arg_locator = shift;
116			my $arg_options = shift;
117	joko	1.19	#my @args = @_;
118			#@args \|\|= ();
119	joko	1.7
120	joko	1.15	if (!$arg_locator) {
121			$logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
122			return;
123			}
124	joko	1.19
125			#print Dumper($arg_locator);
126	joko	1.15
127	cvsjoko	1.1	#my $self = { STORAGEHANDLE => undef, @_ };
128			my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
129	joko	1.7	#$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
130	joko	1.19	$logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new()" );
131	cvsjoko	1.1	return bless $self, $class;
132			}
133
134			sub AUTOLOAD {
135
136	joko	1.2	# since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
137			# some sophisticated handling and filtering is needed to avoid things like
138			# - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
139			# - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
140			# - Deep recursion on anonymous subroutine at [...]
141	joko	1.8	# we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
142	joko	1.2
143	cvsjoko	1.1	my $self = shift;
144			our $AUTOLOAD;
145
146			# ->DESTROY would - if not declared - trigger an AUTOLOAD also
147			return if $AUTOLOAD =~ m/::DESTROY$/;
148
149			my $method = $AUTOLOAD;
150			$method =~ s/^.*:://;
151
152	joko	1.20	#print __PACKAGE__, "\n";
153			#print $method, "\n";
154			#print $self->{locator}, "\n";
155
156			my $locator_type = $self->get_locator_type();
157
158	joko	1.5	# advanced logging of AUTOLOAD calls ...
159			# ... nice but do it only when TRACING (TODO) is enabled
160			my $logstring = "";
161	joko	1.20	$logstring .= __PACKAGE__ . "[$locator_type]" . "->" . $method;
162	joko	1.5	#print "count: ", $#_, "\n";
163			#$logstring .= Dumper(@_) if ($#_ != -1);
164			my $tabcount = int( (80 - length($logstring)) / 10 );
165			$logstring .= "\t" x $tabcount . "(AUTOLOAD)";
166			# TODO: only ok if logstring doesn't contain
167			# e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c)) (AUTOLOAD)"
168	joko	1.8	# but that would be _way_ too specific as long as we don't have an abstract handler for this ;)
169	joko	1.16	if ($TRACELEVEL) {
170	joko	1.5	$logger->debug( $logstring );
171	joko	1.7	#print join('; ', @_);
172	joko	1.5	}
173
174	joko	1.8	# filtering AUTOLOAD calls and first-time-touch of the actual storage impl
175	cvsjoko	1.1	if ($self->_filter_AUTOLOAD($method)) {
176	joko	1.17	#print "=== FILTER!", "\n";
177			$self->_accessStorageHandle();
178	joko	1.16	if ($self->{STORAGEHANDLE}) {
179			return $self->{STORAGEHANDLE}->$method(@_);
180			} else {
181	joko	1.20	my $msg = __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring;
182			$logger->critical( $msg ) if $logger;
183			print STDERR $msg if not $logger;
184	joko	1.16	return;
185			}
186	cvsjoko	1.1	}
187
188			}
189
190			sub _filter_AUTOLOAD {
191			my $self = shift;
192			my $method = shift;
193			if ($self->{options}->{protected}) {
194			if ($method eq 'disconnect') {
195			return;
196			}
197			}
198			return 1;
199			}
200
201
202	joko	1.17	sub _accessStorageHandle {
203	cvsjoko	1.1	my $self = shift;
204			# TODO: to some tracelevel!
205	joko	1.17	#print "=========== _accessStorage", "\n";
206	joko	1.5	if ($TRACELEVEL) {
207	joko	1.17	$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorageHandle()" );
208	joko	1.5	}
209	cvsjoko	1.1	if (!$self->{STORAGEHANDLE}) {
210	joko	1.16	return $self->_createStorageHandle();
211			}
212			}
213
214			sub _createStorageHandle1 {
215			my $self = shift;
216			my $type = $self->{locator}->{type};
217			$logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
218
219			my $pkg = "Data::Storage::Handler::" . $type . "";
220
221			# try to load perl module at runtime
222			my $evalstr = "use $pkg;";
223			eval($evalstr);
224			if ($@) {
225			$logger->error( __PACKAGE__ . "[$type]" . "->_createStorageHandle(): $@" );
226			return;
227	cvsjoko	1.1	}
228	joko	1.16
229			# build up some additional arguments to pass on
230			#my @args = %{$self->{locator}};
231			my @args = ();
232
233			# - create new storage handle object
234			# - propagate arguments to handler
235			# - pass locator by reference to be able to store status- or meta-information in it
236			$self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
237
238	cvsjoko	1.1	}
239
240			sub _createStorageHandle {
241			my $self = shift;
242	joko	1.20
243			# 2003-06-18: protection against storagehandles w/o locators
244			return if not defined $self->{locator};
245
246			my $type = $self->get_locator_type();
247	cvsjoko	1.1	$logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
248
249	joko	1.16	#print Dumper($self);
250			#exit;
251
252	cvsjoko	1.1	my $pkg = "Data::Storage::Handler::" . $type . "";
253
254	joko	1.7	# try to load perl module at runtime
255	joko	1.16	=pod
256	joko	1.7	my $evalstr = "use $pkg;";
257			eval($evalstr);
258			if ($@) {
259			$logger->error( __PACKAGE__ . "[$type]" . "->_createStorageHandle(): $@" );
260			return;
261	cvsjoko	1.1	}
262	joko	1.7
263			# build up some additional arguments to pass on
264			#my @args = %{$self->{locator}};
265			my @args = ();
266
267	joko	1.8	# - create new storage handle object
268			# - propagate arguments to handler
269			# - pass locator by reference to be able to store status- or meta-information in it
270	joko	1.7	$self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
271	joko	1.16	=cut
272
273			$self->{STORAGEHANDLE} = DesignPattern::Object->fromPackage( $pkg, locator => $self->{locator} );
274			return 1;
275	joko	1.3
276	cvsjoko	1.1	}
277
278			sub addLogDispatchHandler {
279
280			my $self = shift;
281			my $name = shift;
282			my $package = shift;
283	joko	1.3	my $logger1 = shift;
284	cvsjoko	1.1	my $objectCreator = shift;
285
286			#$logger->add( Log::Dispatch::Tangram->new( name => $name,
287			$logger->add( $package->new( name => $name,
288			#min_level => 'debug',
289			min_level => 'info',
290			storage => $self,
291			objectCreator => $objectCreator,
292			fields => {
293			message => 'usermsg',
294			timestamp => 'stamp',
295			level => 'level',
296			name => 'code',
297			},
298			filter_patterns => [ '->insert\(SystemEvent=' ],
299			#filter_patterns => [ 'SystemEvent' ],
300
301			#format => '[%d] [%p] %m%n',
302			) );
303
304			}
305
306			sub removeLogDispatchHandler {
307	joko	1.8	my $self = shift;
308			my $name = shift;
309			#my $logger = shift;
310			$logger->remove($name);
311	cvsjoko	1.1	}
312
313	joko	1.20	sub get_locator_type {
314			my $self = shift;
315			my $locator_type = '';
316			$locator_type = $self->{locator}->{type} if defined $self->{locator};
317			return $locator_type;
318			}
319	cvsjoko	1.1
320	joko	1.4	1;
321			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26