Storage/Handler/Abstract.pm

#################################
#
#  $Id: Abstract.pm,v 1.3 2002/11/29 04:58:20 joko Exp $
#
#  $Log: Abstract.pm,v $
#  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(@_);
  }

}

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