--- nfo/perl/libs/Data/Storage/Handler/Abstract.pm 2002/10/17 00:08:07 1.2 +++ nfo/perl/libs/Data/Storage/Handler/Abstract.pm 2003/05/13 07:58:49 1.17 @@ -1,26 +1,84 @@ -################################# -# -# $Id: Abstract.pm,v 1.2 2002/10/17 00:08:07 joko Exp $ -# -# $Log: Abstract.pm,v $ -# Revision 1.2 2002/10/17 00:08:07 joko -# + bugfixes regarding "deep recursion" stuff -# -# Revision 1.1 2002/10/10 03:44:07 cvsjoko -# + new -# -# -################################# +## ------------------------------------------------------------------------ +## $Id: Abstract.pm,v 1.17 2003/05/13 07:58:49 joko Exp $ +## ------------------------------------------------------------------------ +## $Log: Abstract.pm,v $ +## Revision 1.17 2003/05/13 07:58:49 joko +## fix: die if methodname is empty +## fixes to log-string +## +## Revision 1.16 2003/04/18 16:07:53 joko +## just use logger if instantiation successed +## +## Revision 1.15 2003/02/20 20:19:13 joko +## tried to get auto-disconnect working again - failed with that +## +## Revision 1.14 2003/02/09 05:12:28 joko +## + quoting of strings used in sql-queries! +## +## Revision 1.13 2003/01/30 22:27:05 joko +## + added new abstract methods +## +## Revision 1.12 2003/01/30 21:46:32 joko +## + fixed behaviour of AUTOLOAD-method +## +## Revision 1.11 2003/01/20 16:43:18 joko +## + better argument-property merging +## + debugging-output !!! +## + abstract-dummy 'sub createChildNode' +## +## Revision 1.10 2003/01/19 02:31:51 joko +## + fix to 'sub AUTOLOAD' +## +## Revision 1.9 2002/12/19 16:30:23 joko +## + added 'sub dropDb' and 'sub rebuildDb' as croakers for concrete implementations of methods in proper handlers +## +## Revision 1.8 2002/12/13 21:48:35 joko +## + sub _abstract_function +## +## Revision 1.7 2002/12/05 07:57:48 joko +## + now using Tie::SecureHash as a base for the COREHANDLE +## + former public COREHANDLE becomes private _COREHANDLE now +## +## Revision 1.6 2002/12/03 15:52:24 joko +## + fix/feature: if dispatching to deep core method fails (is not declared), try method at Data::Storage - level +## +## Revision 1.5 2002/12/01 22:19:33 joko +## + just disconnect if COREHANDLE exists +## +## Revision 1.4 2002/12/01 04:45:38 joko +## + sub eraseAll +## + sub createDb +## +## Revision 1.3 2002/11/29 04:58:20 joko +## + Storage::Result now uses the same dispatching mechanism like Storage::Handler +## +## Revision 1.2 2002/10/17 00:08:07 joko +## + bugfixes regarding "deep recursion" stuff +## +## Revision 1.1 2002/10/10 03:44:07 cvsjoko +## + new +## ------------------------------------------------------------------------ + package Data::Storage::Handler::Abstract; use strict; use warnings; +use base qw( DesignPattern::Object ); + + use Data::Dumper; +use Tie::SecureHash; +#use Data::Storage::Handler; +use Hash::Merge qw( merge ); + +#use Log::Dispatch::Config; +#Log::Dispatch::Config->configure(); # get logger instance -my $logger = Log::Dispatch::Config->instance; +my $logger; +eval('$logger = Log::Dispatch::Config->instance;'); #our $lock_info; @@ -29,25 +87,86 @@ my $class = ref($invocant) || $invocant; # logging info about the actual handler called - $logger->debug( "$invocant->new( @_ )" ); + $logger->debug( "$invocant->new( @_ )" ) if $logger; #$logger->debug( __PACKAGE__ . "->" . "new()" ); + # V1 - arguments become properties automagically / normal perl mode blessing +=pod + # autovivify passed-in arguments as future object attributes into to-be-blessed hash + my $self = { @_ }; + # create object from blessed hash-reference + bless $self, $class; +=cut + +#=pod + # V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash... + my $self = Tie::SecureHash->new( + $class, + # that's it: + 'metainfo' => undef, + 'lock_info' => undef, + '_COREHANDLE' => undef, + 'meta' => undef, + 'locator' => undef, + 'dataStorageLayer' => undef, + 'dbi' => undef, + # tries: + #'Data::Storage::Handler::Abstract::metainfo' => undef, + #'dataStorageLayer' + #'Data::Storage::Handler::Abstract::dataStorageLayer' => undef, + #'Data::Storage::Handler::Tangram::dataStorageLayer' => undef, + #'Data::Dumper::locator' => undef, + #$class . '::locator' => undef, + #'Data::Storage::Handler::Tangram::locator' => undef, + #'Data::Storage::Handler::DBI::locator' => undef, + #_protected => , + #__private => , + ); +#=cut + + # merge passed-in arguments to constructor as properties into already blessed secure object + + # mungle arguments from array into hash - perl does the job ;) + #my %args = @_; + #my %args = (); + +#print Dumper(@_); + + # merge attributes one-by-one + # TODO: deep_copy? / merge_deep? + while (my $elemName = shift @_) { + #print "elemName: $elemName", "\n"; + if (my $elemValue = shift @_) { + #print Dumper($elemValue); + #print "elemName=$elemName, elemValue=$elemValue", "\n"; + $self->{$elemName} = $elemValue; + } + #$self->{$_} = $args{$_}; + #$self->{$_} = $args{$_}; + } + + # V3 - rolling our own security (just for {COREHANDLE} - nothing else) - nope, Tie::SecureHash works wonderful + #my $self = { @_ }; + #bless $self, $class; + + + # handle meta data - my $metainfo = _getMetaInfo($class); + #my $metainfo = $self->getMetaInfo($class); + my $metainfo = $self->getMetaInfo(); if (!$metainfo->{disconnectMethod}) { $metainfo->{disconnectMethod} = 'disconnect'; } # type? $invocant =~ s/Data::Storage::Handler:://; $metainfo->{type} = $invocant; - # create object from blessed hash-reference # direct accessible (non-protected) properties ( was: my $self = { }; ) - my $self = { metainfo => $metainfo, @_ }; - bless $self, $class; + $self->{metainfo} = $metainfo; return $self; } +# TODO: use NEXT.pm inside this mechanism (to avoid repetitions...) sub AUTOLOAD { # recursion problem to be avoided here!!! @@ -69,24 +188,69 @@ # find out methodname my $methodname = $AUTOLOAD; $methodname =~ s/^.*:://; + +#print "method: $methodname", "\n"; + + # TODO: document this! handler-private methods listed here will not be triggered (internal use) + # in this case, "exists" is a method reserved for Tie::SecureHash, + # which encapsulates the perl data structure (HASH) under this object + # this is to prevent deep recursion's + return if lc $methodname eq 'exists'; + +#print "$methodname - 1", "\n"; + + # TODO: enhance logging/debugging + #if (!$self->exists('COREHANDLE')) { return; } # handle locking (hack) - if ($self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) { + if ($self->can('exists') && $self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) { $self->{lock_info}->{log_lock} = 1; } else { $self->{lock_info}->{log_lock} = 0; } $self->{lock_info}->{last_method} = $methodname; +#print "$methodname - 2", "\n"; + +#print Dumper($self); +#exit; + + # get corehandle instance from underlying handler + my $core = $self->getCOREHANDLE(); + # test for COREHANDLE - if (!$self->{COREHANDLE}) { - #print "no COREHANDLE", "\n"; - if (!$self->{lock_info}->{log_lock}) { - $logger->error( __PACKAGE__ . "[$self->{metainfo}->{type}]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"" ); - } + #if (!$self->{_COREHANDLE}) { +#=pod + #if (!$self->exists('_COREHANDLE')) { + #if (!$self->{_COREHANDLE}) { + if (!$core) { + +#print Dumper($self); +#exit; + + my $handlertype = $self->{metainfo}->{type}; + $handlertype ||= ''; + + my $err_msg_core = __PACKAGE__ . "[$handlertype]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\""; + +#print $err_msg_core, "\n"; + + #if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) { + $logger->error( $err_msg_core ); + #} + + return; + + } +#=cut + + if (!$methodname) { + die("Methodname is not defined!"); return; } +#print "$methodname - 3", "\n"; + # try to dispatch method-call to Storage::Handler::* #if ($self->can($methodname)) { #$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" ); @@ -94,78 +258,125 @@ #if ($res) { return $res; } #} +#print "$methodname - 4", "\n"; + # try to dispatch method-call to COREHANDLE - if ($self->{COREHANDLE}->can($methodname) || $self->{COREHANDLE}->can("AUTOLOAD")) { + # was: + #my $core = $self->{_COREHANDLE}; + # is: + #my $core = $self->getCOREHANDLE(); + +#print Dumper($core); +#exit; + + # was: + #if ($self->{_COREHANDLE}->can($methodname) || $self->{_COREHANDLE}->can("AUTOLOAD")) { + # is: + if ($core->can($methodname) || $core->can("AUTOLOAD")) { #$logger->debug( __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" ); #$lock_AUTOLOAD = 1 if ($methodname eq 'insert'); if (!$self->{lock_info}->{log_lock}) { #print "method: $methodname", "\n"; - $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" ); + my $type = $self->{metainfo}->{type}; + $type ||= ''; + # FIXME! + #$logger->debug( __PACKAGE__ . "[$type]" . "->" . $methodname . "(@_)" ); + $logger->debug( __PACKAGE__ . "[$type]" . "->" . $methodname ); } else { # AUTOLOAD - sub is locked to prevent deep recursions if (e.g.) db-inserts cause log-actions to same db itself } #$lock_AUTOLOAD = 0; #$logger->log( level => 'debug', message => __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" ); - return $self->{COREHANDLE}->$methodname(@_); + +#print "calling: $methodname", "\n"; + + # method calls making it until here will get dispatched to the proper handler + return $core->$methodname(@_); + + } elsif ($self->can($methodname)) { + # try to call specified method inside our or inherited module(s) scope(s) + return $self->$methodname(@_); } } sub DESTROY { my $self = shift; - if ($self->{COREHANDLE}) { + +return; + + $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" ); + + my $disconnectMethod = $self->{metainfo}->{disconnectMethod}; + print "meth: ", $disconnectMethod, "\n"; + + #$disconnectMethod && $self->{_COREHANDLE} && ( $self->{_COREHANDLE}->$disconnectMethod() ); + $self->{_COREHANDLE}->$disconnectMethod(); + #$self->$disconnectMethod(); + + #my $core1 = $self->getCOREHANDLE() if $self->can('getCOREHANDLE'); + #$core1->$disconnectMethod(); + +return; + + print "DESTROY-1", "\n"; + #if ($self->{__COREHANDLE}) { + #if ($self->exists('_COREHANDLE')) { + + # get corehandle instance from underlying handler + my $core; + $core = $self->getCOREHANDLE() if $self->can('getCOREHANDLE'); + + #if ($self->{STORAGEHANDLE}) { + if ($core) { + print "DESTROY-2", "\n"; $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" ); my $disconnectMethod = $self->{metainfo}->{disconnectMethod}; # call "disconnect" or alike on COREHANDLE # was: $self->{COREHANDLE}->disconnect(); - $disconnectMethod && ( $self->{COREHANDLE}->$disconnectMethod() ); + $disconnectMethod && $self->{_COREHANDLE} && ( $self->{_COREHANDLE}->$disconnectMethod() ); - undef $self->{COREHANDLE}; + undef $self->{_COREHANDLE}; } } - -sub _abstract_function { - my $self = shift; - my $fName = shift; - my $class = ref($self); - $logger->error( __PACKAGE__ . ": function \"$fName\" is an abstract method, please implement it in \"$class\""); - #exit; -} - -sub _typeCheck { +sub _typeCheck2 { my $type = shift; print "type: $type"; eval("use Data::Storage::$type;"); } -sub _getMetaInfo { - my $packagename = shift; - #return $self->$metainfo; - - my $ns = '$' . $packagename . "::metainfo"; - $logger->debug( __PACKAGE__ . "->" . "_getMetaInfo()" . " " . "[$ns]" ); - return eval($ns); -} - # ==================================================== # PUBLIC METHODS # ==================================================== - # TODO: abstract "abstract methods" to list/hash to be used in AUTOLOAD - # e.g.: my @ABSTRACT_METHODS = (qw( connect sendCommand getChildNodes )); + sub existsChildNode { + my $self = shift; + my $nodename = shift; + + # TODO: don't use $self->{meta}->{childnodes} directly in here + # get it returned from $self->getChildNodes()!!! - sub connect { + $logger->debug( __PACKAGE__ . "->existsChildNode( nodename=$nodename )" ); + $self->getChildNodes() unless $self->{meta}->{childnodes}; + + # quote this, it might contain meta characters which don't work in a regex + $nodename = quotemeta($nodename); + + # trace + #print Dumper($self->{meta}); + #print "nodename: $nodename", "\n"; - my $self = shift; - $self->_abstract_function('connect'); - return; + # FIXME: use "/i" only on win32-systems! + my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}}); - $logger->debug( "\"connect\" has to be implemented by handler!" ); - return; + return $result; + } + + sub connect_tmp { # my $self = shift; # my $connectionString = shift; @@ -174,11 +385,38 @@ } + +# ==================================================== +# CONCRETE METHOD DUMMIES (croaking via "$logger" by calling "_abstract_function") +# ==================================================== + + # TODO: + # - abstract "abstract methods" to list/hash to be used in AUTOLOAD + # e.g.: my @ABSTRACT_METHODS = (qw( connect sendCommand getChildNodes )); + # use Class::XYZ (Construct) + # - build them via anonymous subs + # - introduce them via symbols + + sub getCOREHANDLE { + my $self = shift; + $self->_abstract_function('getCOREHANDLE'); + } + sub sendCommand { my $self = shift; $self->_abstract_function('sendCommand'); } + sub createChildNode { + my $self = shift; + $self->_abstract_function('createChildNode'); + } + + sub existsChildNode_tmp { + my $self = shift; + $self->_abstract_function('existsChildNode'); + } + sub getChildNodes { my $self = shift; $self->_abstract_function('getChildNodes'); @@ -189,4 +427,94 @@ $self->_abstract_function('configureCOREHANDLE'); } -1; \ No newline at end of file + sub getMetaInfo { + my $self = shift; + $self->_abstract_function('getMetaInfo'); + return; + } + + sub getListUnfiltered { + my $self = shift; + $self->_abstract_function('getListUnfiltered'); + return; + } + + sub getListFiltered { + my $self = shift; + $self->_abstract_function('getListFiltered'); + return; + } + + sub sendQuery { + my $self = shift; + $self->_abstract_function('sendQuery'); + return; + } + + sub connect { + my $self = shift; + $self->_abstract_function('connect'); + return; + } + + sub testIntegrity { + my $self = shift; + $self->_abstract_function('testIntegrity'); + return; + } + + sub quoteSql { + my $self = shift; + $self->_abstract_function('quoteSql'); + return; + } + + sub eraseAll { + my $self = shift; + $self->_abstract_function('eraseAll'); + return; + } + + sub createDb { + my $self = shift; + $self->_abstract_function('createDb'); + return; + } + + sub dropDb { + my $self = shift; + $self->_abstract_function('dropDb'); + return; + } + + sub rebuildDb { + my $self = shift; + $self->_abstract_function('rebuildDb'); + return; + } + + sub getDbName { + my $self = shift; + $self->_abstract_function('getDbName'); + return; + } + + sub testAvailability { + my $self = shift; + $self->_abstract_function('testAvailability'); + return; + } + + sub isConnected { + my $self = shift; + $self->_abstract_function('isConnected'); + return; + } + + sub testDsn { + my $self = shift; + $self->_abstract_function('testDsn'); + return; + } + +1;