Storage/Handler/Abstract.pm

#################################
#
#  $Id: Abstract.pm,v 1.5 2002/12/01 22:19:33 joko Exp $
#
#  $Log: Abstract.pm,v $
#  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 Data::Dumper;

# get logger instance
my $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( @_ )" );
    #$logger->debug( __PACKAGE__ . "->" . "new()" );

  # arguments become properties
  my $self = { @_ };
  # create object from blessed hash-reference
  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;
}


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/^.*:://;

  # handle locking (hack)
  if ($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;
  
  # 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\"" );
    }
    return;
  }

  # 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; }
  #}

  # try to dispatch method-call to COREHANDLE
  if ($self->{COREHANDLE}->can($methodname) || $self->{COREHANDLE}->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 . "(@_)" );
    } 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)" );
    
    # method calls doing it until here will get dispatched to the proper handler
    return $self->{COREHANDLE}->$methodname(@_);
  
  } elsif ($self->can($methodname)) {
    return $self->$methodname(@_);
  }

}

sub DESTROY {
  my $self = shift;
  if ($self->{COREHANDLE}) {
    $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 _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 {
  my $type = shift;
  print "type: $type";
  eval("use Data::Storage::$type;");
}


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

  sub existsChildNode {
    my $self = shift;
    my $nodename = shift;
    #$nodename = 'TransactionRoutingTable';
    $logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );
    $self->getChildNodes() unless $self->{meta}->{childnodes};
    my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}});     # TODO: use "/i" only on win32-systems!
    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 sendCommand {
    my $self = shift;
    $self->_abstract_function('sendCommand');
  }

  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;
  }

1;
1	cvsjoko	1.1	#################################
2			#
3	joko	1.6	# $Id: Abstract.pm,v 1.5 2002/12/01 22:19:33 joko Exp $
4	joko	1.2	#
5			# $Log: Abstract.pm,v $
6	joko	1.6	# Revision 1.5 2002/12/01 22:19:33 joko
7			# + just disconnect if COREHANDLE exists
8			#
9	joko	1.5	# Revision 1.4 2002/12/01 04:45:38 joko
10			# + sub eraseAll
11			# + sub createDb
12			#
13	joko	1.4	# Revision 1.3 2002/11/29 04:58:20 joko
14			# + Storage::Result now uses the same dispatching mechanism like Storage::Handler
15			#
16	joko	1.3	# Revision 1.2 2002/10/17 00:08:07 joko
17			# + bugfixes regarding "deep recursion" stuff
18			#
19	joko	1.2	# Revision 1.1 2002/10/10 03:44:07 cvsjoko
20			# + new
21	cvsjoko	1.1	#
22			#
23			#################################
24
25			package Data::Storage::Handler::Abstract;
26
27			use strict;
28			use warnings;
29
30			use Data::Dumper;
31
32			# get logger instance
33			my $logger = Log::Dispatch::Config->instance;
34
35			#our $lock_info;
36
37			sub new {
38			my $invocant = shift;
39			my $class = ref($invocant) \|\| $invocant;
40
41			# logging info about the actual handler called
42			$logger->debug( "$invocant->new( @_ )" );
43	joko	1.2	#$logger->debug( __PACKAGE__ . "->" . "new()" );
44	cvsjoko	1.1
45	joko	1.3	# arguments become properties
46			my $self = { @_ };
47			# create object from blessed hash-reference
48			bless $self, $class;
49
50	cvsjoko	1.1	# handle meta data
51	joko	1.3	#my $metainfo = $self->getMetaInfo($class);
52			my $metainfo = $self->getMetaInfo();
53	cvsjoko	1.1	if (!$metainfo->{disconnectMethod}) { $metainfo->{disconnectMethod} = 'disconnect'; }
54			# type?
55			$invocant =~ s/Data::Storage::Handler:://;
56			$metainfo->{type} = $invocant;
57
58			# direct accessible (non-protected) properties ( was: my $self = { }; )
59	joko	1.3	$self->{metainfo} = $metainfo;
60	cvsjoko	1.1
61			return $self;
62			}
63
64
65			sub AUTOLOAD {
66
67			# recursion problem to be avoided here!!!
68
69			# - problem: we get recursion-hangs!!! => perl stops with ...
70			# "Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD" at [...]/libs/Data/Storage.pm line 38."
71
72			# - when: if we log to ourselves as a storage-implementation (e.g. via Log::Dispatch::Tangram)
73			# - why: debug-messages are on a very low level including every data-operation to "Data::Storage(::Handler::X)",
74			# so e.g. a "$storage->insert" would trigger another "$storage->insert" itself
75			# which leads to a infinite recursion loop (deep recursion)
76	joko	1.2	# - solution: locks! (by Hack or (maybe) via Perl "local"s)
77	cvsjoko	1.1
78			my $self = shift;
79
80			our $AUTOLOAD;
81			#return if $AUTOLOAD =~ m/::DESTROY$/;
82
83			# find out methodname
84			my $methodname = $AUTOLOAD;
85			$methodname =~ s/^.*:://;
86
87			# handle locking (hack)
88			if ($self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) {
89			$self->{lock_info}->{log_lock} = 1;
90			} else {
91			$self->{lock_info}->{log_lock} = 0;
92			}
93			$self->{lock_info}->{last_method} = $methodname;
94
95			# test for COREHANDLE
96			if (!$self->{COREHANDLE}) {
97	joko	1.2	#print "no COREHANDLE", "\n";
98			if (!$self->{lock_info}->{log_lock}) {
99			$logger->error( __PACKAGE__ . "[$self->{metainfo}->{type}]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"" );
100			}
101	cvsjoko	1.1	return;
102			}
103
104			# try to dispatch method-call to Storage::Handler::*
105			#if ($self->can($methodname)) {
106			#$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
107			#my $res = $self->$methodname(@_);
108			#if ($res) { return $res; }
109			#}
110
111			# try to dispatch method-call to COREHANDLE
112			if ($self->{COREHANDLE}->can($methodname) \|\| $self->{COREHANDLE}->can("AUTOLOAD")) {
113			#$logger->debug( __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
114			#$lock_AUTOLOAD = 1 if ($methodname eq 'insert');
115			if (!$self->{lock_info}->{log_lock}) {
116			#print "method: $methodname", "\n";
117			$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->" . $methodname . "(@_)" );
118			} else {
119			# AUTOLOAD - sub is locked to prevent deep recursions if (e.g.) db-inserts cause log-actions to same db itself
120			}
121			#$lock_AUTOLOAD = 0;
122			#$logger->log( level => 'debug', message => __PACKAGE__ . "->" . $methodname . " (AUTOLOAD)" );
123	joko	1.3
124			# method calls doing it until here will get dispatched to the proper handler
125	cvsjoko	1.1	return $self->{COREHANDLE}->$methodname(@_);
126	joko	1.6
127			} elsif ($self->can($methodname)) {
128			return $self->$methodname(@_);
129	cvsjoko	1.1	}
130
131			}
132
133			sub DESTROY {
134			my $self = shift;
135			if ($self->{COREHANDLE}) {
136			$logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
137
138			my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
139
140			# call "disconnect" or alike on COREHANDLE
141			# was: $self->{COREHANDLE}->disconnect();
142	joko	1.5	$disconnectMethod && $self->{COREHANDLE} && ( $self->{COREHANDLE}->$disconnectMethod() );
143	cvsjoko	1.1
144			undef $self->{COREHANDLE};
145			}
146			}
147
148
149			sub _abstract_function {
150			my $self = shift;
151			my $fName = shift;
152			my $class = ref($self);
153			$logger->error( __PACKAGE__ . ": function \"$fName\" is an abstract method, please implement it in \"$class\"");
154			#exit;
155			}
156
157			sub _typeCheck {
158			my $type = shift;
159			print "type: $type";
160			eval("use Data::Storage::$type;");
161			}
162
163
164			# ====================================================
165			# PUBLIC METHODS
166			# ====================================================
167
168	joko	1.3	sub existsChildNode {
169			my $self = shift;
170			my $nodename = shift;
171			#$nodename = 'TransactionRoutingTable';
172			$logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );
173			$self->getChildNodes() unless $self->{meta}->{childnodes};
174			my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}}); # TODO: use "/i" only on win32-systems!
175			return $result;
176			}
177	cvsjoko	1.1
178	joko	1.3	sub connect_tmp {
179	cvsjoko	1.1
180			# my $self = shift;
181			# my $connectionString = shift;
182			# # todo: patch connectionString to $args
183			# _typeCheck($self->{args}{type});
184
185			}
186
187	joko	1.3
188			# ====================================================
189			# CONCRETE METHOD DUMMIES (croaking via "$logger" by calling "_abstract_function")
190			# ====================================================
191
192			# TODO:
193			# - abstract "abstract methods" to list/hash to be used in AUTOLOAD
194			# e.g.: my @ABSTRACT_METHODS = (qw( connect sendCommand getChildNodes ));
195	joko	1.4	# use Class::XYZ (Construct)
196	joko	1.3	# - build them via anonymous subs
197			# - introduce them via symbols
198
199	cvsjoko	1.1	sub sendCommand {
200			my $self = shift;
201			$self->_abstract_function('sendCommand');
202			}
203
204			sub getChildNodes {
205			my $self = shift;
206			$self->_abstract_function('getChildNodes');
207			}
208
209			sub configureCOREHANDLE {
210			my $self = shift;
211			$self->_abstract_function('configureCOREHANDLE');
212			}
213
214	joko	1.3	sub getMetaInfo {
215			my $self = shift;
216			$self->_abstract_function('getMetaInfo');
217			return;
218			}
219
220			sub getListUnfiltered {
221			my $self = shift;
222			$self->_abstract_function('getListUnfiltered');
223			return;
224			}
225
226			sub getListFiltered {
227			my $self = shift;
228			$self->_abstract_function('getListFiltered');
229			return;
230			}
231
232			sub sendQuery {
233			my $self = shift;
234			$self->_abstract_function('sendQuery');
235			return;
236			}
237
238			sub connect {
239			my $self = shift;
240			$self->_abstract_function('connect');
241			return;
242			}
243
244			sub testIntegrity {
245			my $self = shift;
246			$self->_abstract_function('testIntegrity');
247			return;
248			}
249
250			sub quoteSql {
251			my $self = shift;
252			$self->_abstract_function('quoteSql');
253	joko	1.4	return;
254			}
255
256			sub eraseAll {
257			my $self = shift;
258			$self->_abstract_function('eraseAll');
259			return;
260			}
261
262			sub createDb {
263			my $self = shift;
264			$self->_abstract_function('createDb');
265	joko	1.3	return;
266			}
267
268			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26