Storage/Handler/Abstract.pm

##    ------------------------------------------------------------------------
##    $Id: Abstract.pm,v 1.18 2003/06/06 03:40:57 joko Exp $
##    ------------------------------------------------------------------------
##    $Log: Abstract.pm,v $
##    Revision 1.18  2003/06/06 03:40:57  joko
##    disabled autovivifying of arguments as attributes
##
##    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;
eval('$logger = Log::Dispatch::Config->instance;');

#our $lock_info;

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  
  # logging info about the actual handler called
    $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 = $self->getMetaInfo($class);
    my $metainfo = $self->getMetaInfo();
    #if (!$metainfo->{disconnectMethod}) { $metainfo->{disconnectMethod} = 'disconnect'; }
    # type?
    $invocant =~ s/Data::Storage::Handler:://;
    $metainfo->{type} = $invocant;

    # direct accessible (non-protected) properties         ( was: my $self = { }; )
    $self->{metainfo} = $metainfo;

  return $self;
}


# TODO: use NEXT.pm inside this mechanism (to avoid repetitions...)
sub AUTOLOAD {

  # recursion problem to be avoided here!!!
  
    # - problem: we get recursion-hangs!!!   =>  perl stops with ...
    # "Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD" at [...]/libs/Data/Storage.pm line 38."
    
    # - when: if we log to ourselves as a storage-implementation (e.g. via Log::Dispatch::Tangram)
    # - why:  debug-messages are on a very low level including every data-operation to "Data::Storage(::Handler::X)",
    #             so e.g. a "$storage->insert" would trigger another "$storage->insert" itself 
    #             which leads to a infinite recursion loop (deep recursion)
    # - solution: locks! (by Hack or (maybe) via Perl "local"s)

  my $self = shift;

  our $AUTOLOAD;
  #return if $AUTOLOAD =~ m/::DESTROY$/;

  # 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->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}) {
#=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

=pod
  if (!$methodname) {
    die("Methodname is not defined!");
    return;
  }
=cut

#print "$methodname - 3", "\n";

  # try to dispatch method-call to Storage::Handler::*
  #if ($self->can($methodname)) {
    #$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
    #my $res = $self->$methodname(@_);
    #if ($res) { return $res; }
  #}

#print "$methodname - 4", "\n";

  # try to dispatch method-call to COREHANDLE
  # 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";
      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)" );
    
#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;

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} && ( $self->{_COREHANDLE}->$disconnectMethod() );

    undef $self->{_COREHANDLE};
  }
}

sub _typeCheck2 {
  my $type = shift;
  print "type: $type";
  eval("use Data::Storage::$type;");
}


# ====================================================
#   PUBLIC METHODS
# ====================================================

  sub existsChildNode {
    my $self = shift;
    my $nodename = shift;

    # TODO: don't use $self->{meta}->{childnodes} directly in here
    # get it returned from $self->getChildNodes()!!!

    $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";
    
    # FIXME: use "/i" only on win32-systems!
    my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}});
    
    return $result;
  }

  sub connect_tmp {
    
#    my $self = shift;
#    my $connectionString = shift;
#    # todo: patch connectionString to $args
#    _typeCheck($self->{args}{type});

  }
  

# ====================================================
#   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');
  }

  sub configureCOREHANDLE {
    my $self = shift;
    $self->_abstract_function('configureCOREHANDLE');
  }

  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;
1	joko	1.11	## ------------------------------------------------------------------------
2	joko	1.19	## $Id: Abstract.pm,v 1.18 2003/06/06 03:40:57 joko Exp $
3	joko	1.11	## ------------------------------------------------------------------------
4	joko	1.7	## $Log: Abstract.pm,v $
5	joko	1.19	## Revision 1.18 2003/06/06 03:40:57 joko
6			## disabled autovivifying of arguments as attributes
7			##
8	joko	1.18	## Revision 1.17 2003/05/13 07:58:49 joko
9			## fix: die if methodname is empty
10			## fixes to log-string
11			##
12	joko	1.17	## Revision 1.16 2003/04/18 16:07:53 joko
13			## just use logger if instantiation successed
14			##
15	joko	1.16	## Revision 1.15 2003/02/20 20:19:13 joko
16			## tried to get auto-disconnect working again - failed with that
17			##
18	joko	1.15	## Revision 1.14 2003/02/09 05:12:28 joko
19			## + quoting of strings used in sql-queries!
20			##
21	joko	1.14	## Revision 1.13 2003/01/30 22:27:05 joko
22			## + added new abstract methods
23			##
24	joko	1.13	## Revision 1.12 2003/01/30 21:46:32 joko
25			## + fixed behaviour of AUTOLOAD-method
26			##
27	joko	1.12	## Revision 1.11 2003/01/20 16:43:18 joko
28			## + better argument-property merging
29			## + debugging-output !!!
30			## + abstract-dummy 'sub createChildNode'
31			##
32	joko	1.11	## Revision 1.10 2003/01/19 02:31:51 joko
33			## + fix to 'sub AUTOLOAD'
34			##
35	joko	1.10	## Revision 1.9 2002/12/19 16:30:23 joko
36			## + added 'sub dropDb' and 'sub rebuildDb' as croakers for concrete implementations of methods in proper handlers
37			##
38	joko	1.9	## Revision 1.8 2002/12/13 21:48:35 joko
39			## + sub _abstract_function
40			##
41	joko	1.8	## Revision 1.7 2002/12/05 07:57:48 joko
42			## + now using Tie::SecureHash as a base for the COREHANDLE
43			## + former public COREHANDLE becomes private _COREHANDLE now
44			##
45	joko	1.7	## Revision 1.6 2002/12/03 15:52:24 joko
46			## + fix/feature: if dispatching to deep core method fails (is not declared), try method at Data::Storage - level
47			##
48			## Revision 1.5 2002/12/01 22:19:33 joko
49			## + just disconnect if COREHANDLE exists
50			##
51			## Revision 1.4 2002/12/01 04:45:38 joko
52			## + sub eraseAll
53			## + sub createDb
54			##
55			## Revision 1.3 2002/11/29 04:58:20 joko
56			## + Storage::Result now uses the same dispatching mechanism like Storage::Handler
57			##
58			## Revision 1.2 2002/10/17 00:08:07 joko
59			## + bugfixes regarding "deep recursion" stuff
60			##
61			## Revision 1.1 2002/10/10 03:44:07 cvsjoko
62			## + new
63	joko	1.11	## ------------------------------------------------------------------------
64	joko	1.7
65	cvsjoko	1.1
66			package Data::Storage::Handler::Abstract;
67
68			use strict;
69			use warnings;
70
71	joko	1.8	use base qw( DesignPattern::Object );
72
73	joko	1.11
74	cvsjoko	1.1	use Data::Dumper;
75	joko	1.7	use Tie::SecureHash;
76			#use Data::Storage::Handler;
77	joko	1.15	use Hash::Merge qw( merge );
78	joko	1.11
79	joko	1.16	#use Log::Dispatch::Config;
80			#Log::Dispatch::Config->configure();
81	cvsjoko	1.1
82			# get logger instance
83	joko	1.16	my $logger;
84			eval('$logger = Log::Dispatch::Config->instance;');
85	cvsjoko	1.1
86			#our $lock_info;
87
88			sub new {
89			my $invocant = shift;
90			my $class = ref($invocant) \|\| $invocant;
91
92			# logging info about the actual handler called
93	joko	1.16	$logger->debug( "$invocant->new( @_ )" ) if $logger;
94	joko	1.2	#$logger->debug( __PACKAGE__ . "->" . "new()" );
95	cvsjoko	1.1
96	joko	1.7	# V1 - arguments become properties automagically / normal perl mode blessing
97			=pod
98			# autovivify passed-in arguments as future object attributes into to-be-blessed hash
99	joko	1.3	my $self = { @_ };
100			# create object from blessed hash-reference
101			bless $self, $class;
102	joko	1.7	=cut
103
104	joko	1.10	#=pod
105	joko	1.7	# V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash...
106			my $self = Tie::SecureHash->new(
107			$class,
108			# that's it:
109			'metainfo' => undef,
110			'lock_info' => undef,
111			'_COREHANDLE' => undef,
112			'meta' => undef,
113			'locator' => undef,
114			'dataStorageLayer' => undef,
115			'dbi' => undef,
116			# tries:
117			#'Data::Storage::Handler::Abstract::metainfo' => undef,
118			#'dataStorageLayer'
119			#'Data::Storage::Handler::Abstract::dataStorageLayer' => undef,
120			#'Data::Storage::Handler::Tangram::dataStorageLayer' => undef,
121			#'Data::Dumper::locator' => undef,
122			#$class . '::locator' => undef,
123			#'Data::Storage::Handler::Tangram::locator' => undef,
124			#'Data::Storage::Handler::DBI::locator' => undef,
125			#_protected => ,
126			#__private => ,
127			);
128	joko	1.10	#=cut
129	joko	1.7
130			# merge passed-in arguments to constructor as properties into already blessed secure object
131	joko	1.11
132	joko	1.7	# mungle arguments from array into hash - perl does the job ;)
133	joko	1.11	#my %args = @_;
134			#my %args = ();
135
136			#print Dumper(@_);
137
138	joko	1.7	# merge attributes one-by-one
139			# TODO: deep_copy? / merge_deep?
140	joko	1.11	while (my $elemName = shift @_) {
141			#print "elemName: $elemName", "\n";
142			if (my $elemValue = shift @_) {
143			#print Dumper($elemValue);
144			#print "elemName=$elemName, elemValue=$elemValue", "\n";
145			$self->{$elemName} = $elemValue;
146			}
147			#$self->{$_} = $args{$_};
148			#$self->{$_} = $args{$_};
149	joko	1.7	}
150
151			# V3 - rolling our own security (just for {COREHANDLE} - nothing else) - nope, Tie::SecureHash works wonderful
152			#my $self = { @_ };
153			#bless $self, $class;
154
155
156	joko	1.3
157	cvsjoko	1.1	# handle meta data
158	joko	1.3	#my $metainfo = $self->getMetaInfo($class);
159			my $metainfo = $self->getMetaInfo();
160	joko	1.19	#if (!$metainfo->{disconnectMethod}) { $metainfo->{disconnectMethod} = 'disconnect'; }
161	cvsjoko	1.1	# type?
162			$invocant =~ s/Data::Storage::Handler:://;
163			$metainfo->{type} = $invocant;
164
165			# direct accessible (non-protected) properties ( was: my $self = { }; )
166	joko	1.3	$self->{metainfo} = $metainfo;
167	cvsjoko	1.1
168			return $self;
169			}
170
171
172	joko	1.10	# TODO: use NEXT.pm inside this mechanism (to avoid repetitions...)
173	cvsjoko	1.1	sub AUTOLOAD {
174
175			# recursion problem to be avoided here!!!
176
177			# - problem: we get recursion-hangs!!! => perl stops with ...
178			# "Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD" at [...]/libs/Data/Storage.pm line 38."
179
180			# - when: if we log to ourselves as a storage-implementation (e.g. via Log::Dispatch::Tangram)
181			# - why: debug-messages are on a very low level including every data-operation to "Data::Storage(::Handler::X)",
182			# so e.g. a "$storage->insert" would trigger another "$storage->insert" itself
183			# which leads to a infinite recursion loop (deep recursion)
184	joko	1.2	# - solution: locks! (by Hack or (maybe) via Perl "local"s)
185	cvsjoko	1.1
186			my $self = shift;
187
188			our $AUTOLOAD;
189			#return if $AUTOLOAD =~ m/::DESTROY$/;
190
191			# find out methodname
192			my $methodname = $AUTOLOAD;
193			$methodname =~ s/^.*:://;
194	joko	1.7
195			#print "method: $methodname", "\n";
196
197			# TODO: document this! handler-private methods listed here will not be triggered (internal use)
198			# in this case, "exists" is a method reserved for Tie::SecureHash,
199			# which encapsulates the perl data structure (HASH) under this object
200			# this is to prevent deep recursion's
201			return if lc $methodname eq 'exists';
202
203	joko	1.12	#print "$methodname - 1", "\n";
204	joko	1.7
205			# TODO: enhance logging/debugging
206			#if (!$self->exists('COREHANDLE')) { return; }
207	cvsjoko	1.1
208			# handle locking (hack)
209	joko	1.10	if ($self->can('exists') && $self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) {
210	cvsjoko	1.1	$self->{lock_info}->{log_lock} = 1;
211			} else {
212			$self->{lock_info}->{log_lock} = 0;
213			}
214			$self->{lock_info}->{last_method} = $methodname;
215
216	joko	1.12	#print "$methodname - 2", "\n";
217	joko	1.7
218			#print Dumper($self);
219			#exit;
220
221			# get corehandle instance from underlying handler
222			my $core = $self->getCOREHANDLE();
223
224	cvsjoko	1.1	# test for COREHANDLE
225	joko	1.7	#if (!$self->{_COREHANDLE}) {
226			#=pod
227			#if (!$self->exists('_COREHANDLE')) {
228			#if (!$self->{_COREHANDLE}) {
229			if (!$core) {
230	joko	1.10
231			#print Dumper($self);
232			#exit;
233
234			my $handlertype = $self->{metainfo}->{type};
235			$handlertype \|\|= '';
236
237			my $err_msg_core = __PACKAGE__ . "[$handlertype]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"";
238	joko	1.12
239			#print $err_msg_core, "\n";
240
241			#if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) {
242	joko	1.7	$logger->error( $err_msg_core );
243	joko	1.12	#}
244
245	cvsjoko	1.1	return;
246	joko	1.12
247	cvsjoko	1.1	}
248	joko	1.7	#=cut
249
250	joko	1.18	=pod
251	joko	1.17	if (!$methodname) {
252			die("Methodname is not defined!");
253			return;
254			}
255	joko	1.18	=cut
256	joko	1.17
257	joko	1.7	#print "$methodname - 3", "\n";
258	cvsjoko	1.1
259			# try to dispatch method-call to Storage::Handler::*
260			#if ($self->can($methodname)) {
261			#$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
262			#my $res = $self->$methodname(@_);
263			#if ($res) { return $res; }
264			#}
265
266	joko	1.7	#print "$methodname - 4", "\n";
267
268	cvsjoko	1.1	# try to dispatch method-call to COREHANDLE
269	joko	1.7	# was:
270			#my $core = $self->{_COREHANDLE};
271			# is:
272			#my $core = $self->getCOREHANDLE();
273
274			#print Dumper($core);
275			#exit;
276
277			# was:
278			#if ($self->{_COREHANDLE}->can($methodname) \|\| $self->{_COREHANDLE}->can("AUTOLOAD")) {
279			# is:
280			if ($core->can($methodname) \|\| $core->can("AUTOLOAD")) {
281	cvsjoko	1.1	#$logger->debug( __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
282			#$lock_AUTOLOAD = 1 if ($methodname eq 'insert');
283			if (!$self->{lock_info}->{log_lock}) {
284			#print "method: $methodname", "\n";
285	joko	1.17	my $type = $self->{metainfo}->{type};
286			$type \|\|= '';
287			# FIXME!
288			#$logger->debug( __PACKAGE__ . "[$type]" . "->" . $methodname . "(@_)" );
289			$logger->debug( __PACKAGE__ . "[$type]" . "->" . $methodname );
290	cvsjoko	1.1	} else {
291			# AUTOLOAD - sub is locked to prevent deep recursions if (e.g.) db-inserts cause log-actions to same db itself
292			}
293			#$lock_AUTOLOAD = 0;
294			#$logger->log( level => 'debug', message => __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
295	joko	1.3
296	joko	1.7	#print "calling: $methodname", "\n";
297
298	joko	1.10	# method calls making it until here will get dispatched to the proper handler
299	joko	1.7	return $core->$methodname(@_);
300	joko	1.6
301			} elsif ($self->can($methodname)) {
302	joko	1.10	# try to call specified method inside our or inherited module(s) scope(s)
303	joko	1.6	return $self->$methodname(@_);
304	cvsjoko	1.1	}
305
306			}
307
308			sub DESTROY {
309			my $self = shift;
310	joko	1.15
311			return;
312
313			$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
314
315			my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
316			print "meth: ", $disconnectMethod, "\n";
317
318			#$disconnectMethod && $self->{_COREHANDLE} && ( $self->{_COREHANDLE}->$disconnectMethod() );
319			$self->{_COREHANDLE}->$disconnectMethod();
320			#$self->$disconnectMethod();
321
322			#my $core1 = $self->getCOREHANDLE() if $self->can('getCOREHANDLE');
323			#$core1->$disconnectMethod();
324
325			return;
326
327			print "DESTROY-1", "\n";
328			#if ($self->{__COREHANDLE}) {
329			#if ($self->exists('_COREHANDLE')) {
330
331			# get corehandle instance from underlying handler
332			my $core;
333			$core = $self->getCOREHANDLE() if $self->can('getCOREHANDLE');
334
335			#if ($self->{STORAGEHANDLE}) {
336			if ($core) {
337			print "DESTROY-2", "\n";
338	cvsjoko	1.1	$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
339
340			my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
341
342			# call "disconnect" or alike on COREHANDLE
343			# was: $self->{COREHANDLE}->disconnect();
344	joko	1.7	$disconnectMethod && $self->{_COREHANDLE} && ( $self->{_COREHANDLE}->$disconnectMethod() );
345	cvsjoko	1.1
346	joko	1.7	undef $self->{_COREHANDLE};
347	cvsjoko	1.1	}
348			}
349
350	joko	1.7	sub _typeCheck2 {
351	cvsjoko	1.1	my $type = shift;
352			print "type: $type";
353			eval("use Data::Storage::$type;");
354			}
355
356
357			# ====================================================
358			# PUBLIC METHODS
359			# ====================================================
360
361	joko	1.3	sub existsChildNode {
362			my $self = shift;
363			my $nodename = shift;
364	joko	1.14
365			# TODO: don't use $self->{meta}->{childnodes} directly in here
366			# get it returned from $self->getChildNodes()!!!
367
368			$logger->debug( __PACKAGE__ . "->existsChildNode( nodename=$nodename )" );
369	joko	1.3	$self->getChildNodes() unless $self->{meta}->{childnodes};
370	joko	1.14
371			# quote this, it might contain meta characters which don't work in a regex
372			$nodename = quotemeta($nodename);
373
374			# trace
375			#print Dumper($self->{meta});
376			#print "nodename: $nodename", "\n";
377
378			# FIXME: use "/i" only on win32-systems!
379			my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}});
380
381	joko	1.3	return $result;
382			}
383	cvsjoko	1.1
384	joko	1.3	sub connect_tmp {
385	cvsjoko	1.1
386			# my $self = shift;
387			# my $connectionString = shift;
388			# # todo: patch connectionString to $args
389			# _typeCheck($self->{args}{type});
390
391			}
392
393	joko	1.3
394			# ====================================================
395			# CONCRETE METHOD DUMMIES (croaking via "$logger" by calling "_abstract_function")
396			# ====================================================
397
398			# TODO:
399			# - abstract "abstract methods" to list/hash to be used in AUTOLOAD
400			# e.g.: my @ABSTRACT_METHODS = (qw( connect sendCommand getChildNodes ));
401	joko	1.4	# use Class::XYZ (Construct)
402	joko	1.3	# - build them via anonymous subs
403			# - introduce them via symbols
404
405	joko	1.7	sub getCOREHANDLE {
406			my $self = shift;
407			$self->_abstract_function('getCOREHANDLE');
408			}
409
410	cvsjoko	1.1	sub sendCommand {
411			my $self = shift;
412			$self->_abstract_function('sendCommand');
413	joko	1.11	}
414
415			sub createChildNode {
416			my $self = shift;
417			$self->_abstract_function('createChildNode');
418	joko	1.7	}
419
420			sub existsChildNode_tmp {
421			my $self = shift;
422			$self->_abstract_function('existsChildNode');
423	cvsjoko	1.1	}
424
425			sub getChildNodes {
426			my $self = shift;
427			$self->_abstract_function('getChildNodes');
428			}
429
430			sub configureCOREHANDLE {
431			my $self = shift;
432			$self->_abstract_function('configureCOREHANDLE');
433			}
434
435	joko	1.3	sub getMetaInfo {
436			my $self = shift;
437			$self->_abstract_function('getMetaInfo');
438			return;
439			}
440
441			sub getListUnfiltered {
442			my $self = shift;
443			$self->_abstract_function('getListUnfiltered');
444			return;
445			}
446
447			sub getListFiltered {
448			my $self = shift;
449			$self->_abstract_function('getListFiltered');
450			return;
451			}
452
453			sub sendQuery {
454			my $self = shift;
455			$self->_abstract_function('sendQuery');
456			return;
457			}
458
459			sub connect {
460			my $self = shift;
461			$self->_abstract_function('connect');
462			return;
463			}
464
465			sub testIntegrity {
466			my $self = shift;
467			$self->_abstract_function('testIntegrity');
468			return;
469			}
470
471			sub quoteSql {
472			my $self = shift;
473			$self->_abstract_function('quoteSql');
474	joko	1.4	return;
475			}
476
477			sub eraseAll {
478			my $self = shift;
479			$self->_abstract_function('eraseAll');
480			return;
481			}
482
483			sub createDb {
484			my $self = shift;
485			$self->_abstract_function('createDb');
486	joko	1.9	return;
487			}
488
489			sub dropDb {
490			my $self = shift;
491			$self->_abstract_function('dropDb');
492			return;
493			}
494
495			sub rebuildDb {
496			my $self = shift;
497			$self->_abstract_function('rebuildDb');
498	joko	1.13	return;
499			}
500
501			sub getDbName {
502			my $self = shift;
503			$self->_abstract_function('getDbName');
504			return;
505			}
506
507			sub testAvailability {
508			my $self = shift;
509			$self->_abstract_function('testAvailability');
510			return;
511			}
512
513			sub isConnected {
514			my $self = shift;
515			$self->_abstract_function('isConnected');
516			return;
517			}
518
519			sub testDsn {
520			my $self = shift;
521			$self->_abstract_function('testDsn');
522	joko	1.3	return;
523			}
524
525			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26