/[cvs]/nfo/perl/libs/Data/Storage/Handler/Abstract.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Data/Storage/Handler/Abstract.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations)
Thu Jan 30 21:46:32 2003 UTC (21 years, 5 months ago) by joko
Branch: MAIN
Changes since 1.11: +15 -6 lines
+ fixed behaviour of AUTOLOAD-method

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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed