/[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.11 - (hide annotations)
Mon Jan 20 16:43:18 2003 UTC (21 years, 5 months ago) by joko
Branch: MAIN
Changes since 1.10: +32 -12 lines
+ better argument-property merging
+ debugging-output !!!
+ abstract-dummy 'sub createChildNode'

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

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