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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by joko, Thu Dec 19 16:30:23 2002 UTC revision 1.16 by joko, Fri Apr 18 16:07:53 2003 UTC
# Line 1  Line 1 
1  ##    --------------------------------------------------------------------------------  ##    ------------------------------------------------------------------------
2  ##    $Id$  ##    $Id$
3  ##    --------------------------------------------------------------------------------  ##    ------------------------------------------------------------------------
4  ##    $Log$  ##    $Log$
5    ##    Revision 1.16  2003/04/18 16:07:53  joko
6    ##    just use logger if instantiation successed
7    ##
8    ##    Revision 1.15  2003/02/20 20:19:13  joko
9    ##    tried to get auto-disconnect working again - failed with that
10    ##
11    ##    Revision 1.14  2003/02/09 05:12:28  joko
12    ##    + quoting of strings used in sql-queries!
13    ##
14    ##    Revision 1.13  2003/01/30 22:27:05  joko
15    ##    + added new abstract methods
16    ##
17    ##    Revision 1.12  2003/01/30 21:46:32  joko
18    ##    + fixed behaviour of AUTOLOAD-method
19    ##
20    ##    Revision 1.11  2003/01/20 16:43:18  joko
21    ##    + better argument-property merging
22    ##    + debugging-output !!!
23    ##    + abstract-dummy 'sub createChildNode'
24    ##
25    ##    Revision 1.10  2003/01/19 02:31:51  joko
26    ##    + fix to 'sub AUTOLOAD'
27    ##
28  ##    Revision 1.9  2002/12/19 16:30:23  joko  ##    Revision 1.9  2002/12/19 16:30:23  joko
29  ##    + added 'sub dropDb' and 'sub rebuildDb' as croakers for concrete implementations of methods in proper handlers  ##    + added 'sub dropDb' and 'sub rebuildDb' as croakers for concrete implementations of methods in proper handlers
30  ##  ##
# Line 30  Line 53 
53  ##  ##
54  ##    Revision 1.1  2002/10/10 03:44:07  cvsjoko  ##    Revision 1.1  2002/10/10 03:44:07  cvsjoko
55  ##    + new  ##    + new
56  ##    --------------------------------------------------------------------------------  ##    ------------------------------------------------------------------------
57    
58    
59  package Data::Storage::Handler::Abstract;  package Data::Storage::Handler::Abstract;
# Line 40  use warnings; Line 63  use warnings;
63    
64  use base qw( DesignPattern::Object );  use base qw( DesignPattern::Object );
65    
66    
67  use Data::Dumper;  use Data::Dumper;
68  use Tie::SecureHash;  use Tie::SecureHash;
69  #use Data::Storage::Handler;  #use Data::Storage::Handler;
70    use Hash::Merge qw( merge );
71    
72    #use Log::Dispatch::Config;
73    #Log::Dispatch::Config->configure();
74    
75  # get logger instance  # get logger instance
76  my $logger = Log::Dispatch::Config->instance;  my $logger;
77    eval('$logger = Log::Dispatch::Config->instance;');
78    
79  #our $lock_info;  #our $lock_info;
80    
# Line 54  sub new { Line 83  sub new {
83    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
84        
85    # logging info about the actual handler called    # logging info about the actual handler called
86      $logger->debug( "$invocant->new( @_ )" );      $logger->debug( "$invocant->new( @_ )" ) if $logger;
87      #$logger->debug( __PACKAGE__ . "->" . "new()" );      #$logger->debug( __PACKAGE__ . "->" . "new()" );
88    
89    # V1 - arguments become properties automagically / normal perl mode blessing    # V1 - arguments become properties automagically / normal perl mode blessing
# Line 65  sub new { Line 94  sub new {
94    bless $self, $class;    bless $self, $class;
95  =cut  =cut
96    
97    #=pod
98    # V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash...    # V2 - maybe more convenient/secure? utilizing Damian Conway's Tie::SecureHash...
99    my $self = Tie::SecureHash->new(    my $self = Tie::SecureHash->new(
100      $class,      $class,
# Line 89  sub new { Line 118  sub new {
118        #_protected => ,        #_protected => ,
119        #__private => ,        #__private => ,
120    );    );
121    #=cut
122    
123    # merge passed-in arguments to constructor as properties into already blessed secure object    # merge passed-in arguments to constructor as properties into already blessed secure object
124        
125      # mungle arguments from array into hash - perl does the job  ;)      # mungle arguments from array into hash - perl does the job  ;)
126      my %args = @_;      #my %args = @_;
127          #my %args = ();
128    
129    #print Dumper(@_);
130    
131      # merge attributes one-by-one      # merge attributes one-by-one
132      # TODO: deep_copy? / merge_deep?      # TODO: deep_copy? / merge_deep?
133      foreach (keys %args) {      while (my $elemName = shift @_) {
134        #print "key: $_", "\n";        #print "elemName: $elemName", "\n";
135        $self->{$_} = $args{$_};        if (my $elemValue = shift @_) {
136            #print Dumper($elemValue);
137            #print "elemName=$elemName, elemValue=$elemValue", "\n";
138            $self->{$elemName} = $elemValue;
139          }
140          #$self->{$_} = $args{$_};
141          #$self->{$_} = $args{$_};
142      }      }
143        
144    # V3 - rolling our own security (just for {COREHANDLE} - nothing else)  -  nope, Tie::SecureHash works wonderful    # V3 - rolling our own security (just for {COREHANDLE} - nothing else)  -  nope, Tie::SecureHash works wonderful
# Line 124  sub new { Line 162  sub new {
162  }  }
163    
164    
165    # TODO: use NEXT.pm inside this mechanism (to avoid repetitions...)
166  sub AUTOLOAD {  sub AUTOLOAD {
167    
168    # recursion problem to be avoided here!!!    # recursion problem to be avoided here!!!
# Line 160  sub AUTOLOAD { Line 199  sub AUTOLOAD {
199    #if (!$self->exists('COREHANDLE')) { return; }    #if (!$self->exists('COREHANDLE')) { return; }
200    
201    # handle locking (hack)    # handle locking (hack)
202    if ($self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) {    if ($self->can('exists') && $self->exists('lock_info') && $self->{lock_info}->{last_method} && $methodname eq $self->{lock_info}->{last_method}) {
203      $self->{lock_info}->{log_lock} = 1;      $self->{lock_info}->{log_lock} = 1;
204    } else {    } else {
205      $self->{lock_info}->{log_lock} = 0;      $self->{lock_info}->{log_lock} = 0;
# Line 181  sub AUTOLOAD { Line 220  sub AUTOLOAD {
220    #if (!$self->exists('_COREHANDLE')) {    #if (!$self->exists('_COREHANDLE')) {
221    #if (!$self->{_COREHANDLE}) {    #if (!$self->{_COREHANDLE}) {
222    if (!$core) {    if (!$core) {
223      my $err_msg_core = __PACKAGE__ . "[$self->{metainfo}->{type}]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"";  
224  print $err_msg_core, "\n";  #print Dumper($self);    
225      if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) {  #exit;
226    
227        my $handlertype = $self->{metainfo}->{type};
228        $handlertype ||= '';
229    
230        my $err_msg_core = __PACKAGE__ . "[$handlertype]" . ": " . "COREHANDLE is undefined while trying to execute method \"$methodname\"";
231    
232    #print $err_msg_core, "\n";
233    
234        #if ($self->exists('lock_info') && !$self->{lock_info}->{log_lock}) {
235        $logger->error( $err_msg_core );        $logger->error( $err_msg_core );
236      }      #}
237    
238      return;      return;
239        
240    }    }
241  #=cut  #=cut
242    
# Line 227  print $err_msg_core, "\n"; Line 277  print $err_msg_core, "\n";
277            
278  #print "calling: $methodname", "\n";  #print "calling: $methodname", "\n";
279            
280      # method calls doing it until here will get dispatched to the proper handler      # method calls making it until here will get dispatched to the proper handler
281      return $core->$methodname(@_);      return $core->$methodname(@_);
282        
283    } elsif ($self->can($methodname)) {    } elsif ($self->can($methodname)) {
284        # try to call specified method inside our or inherited module(s) scope(s)
285      return $self->$methodname(@_);      return $self->$methodname(@_);
286    }    }
287    
# Line 238  print $err_msg_core, "\n"; Line 289  print $err_msg_core, "\n";
289    
290  sub DESTROY {  sub DESTROY {
291    my $self = shift;    my $self = shift;
292    #if ($self->{COREHANDLE}) {  
293    if ($self->exists('_COREHANDLE')) {  return;
294    
295      $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
296    
297      my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
298      print "meth: ", $disconnectMethod, "\n";
299      
300      #$disconnectMethod && $self->{_COREHANDLE} && ( $self->{_COREHANDLE}->$disconnectMethod() );
301      $self->{_COREHANDLE}->$disconnectMethod();
302      #$self->$disconnectMethod();
303    
304      #my $core1 = $self->getCOREHANDLE() if $self->can('getCOREHANDLE');
305      #$core1->$disconnectMethod();
306    
307    return;
308    
309      print "DESTROY-1", "\n";
310      #if ($self->{__COREHANDLE}) {
311      #if ($self->exists('_COREHANDLE')) {
312    
313      # get corehandle instance from underlying handler
314      my $core;
315      $core = $self->getCOREHANDLE() if $self->can('getCOREHANDLE');
316    
317      #if ($self->{STORAGEHANDLE}) {
318      if ($core) {
319        print "DESTROY-2", "\n";
320      $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );      $logger->debug( __PACKAGE__ . "[$self->{metainfo}->{type}]" . "->DESTROY" );
321    
322      my $disconnectMethod = $self->{metainfo}->{disconnectMethod};      my $disconnectMethod = $self->{metainfo}->{disconnectMethod};
# Line 266  sub _typeCheck2 { Line 343  sub _typeCheck2 {
343    sub existsChildNode {    sub existsChildNode {
344      my $self = shift;      my $self = shift;
345      my $nodename = shift;      my $nodename = shift;
346      #$nodename = 'TransactionRoutingTable';  
347      $logger->debug( __PACKAGE__ . "->getChildNode( nodename $nodename )" );      # TODO: don't use $self->{meta}->{childnodes} directly in here
348        # get it returned from $self->getChildNodes()!!!
349    
350        $logger->debug( __PACKAGE__ . "->existsChildNode( nodename=$nodename )" );
351      $self->getChildNodes() unless $self->{meta}->{childnodes};      $self->getChildNodes() unless $self->{meta}->{childnodes};
352      my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}});     # TODO: use "/i" only on win32-systems!  
353        # quote this, it might contain meta characters which don't work in a regex
354          $nodename = quotemeta($nodename);
355    
356        # trace
357          #print Dumper($self->{meta});
358          #print "nodename: $nodename", "\n";
359        
360        # FIXME: use "/i" only on win32-systems!
361        my $result = grep(m/$nodename/i, @{$self->{meta}->{childnodes}});
362        
363      return $result;      return $result;
364    }    }
365    
# Line 304  sub _typeCheck2 { Line 394  sub _typeCheck2 {
394      $self->_abstract_function('sendCommand');      $self->_abstract_function('sendCommand');
395    }    }
396    
397      sub createChildNode {
398        my $self = shift;
399        $self->_abstract_function('createChildNode');
400      }
401    
402    sub existsChildNode_tmp {    sub existsChildNode_tmp {
403      my $self = shift;      my $self = shift;
404      $self->_abstract_function('existsChildNode');      $self->_abstract_function('existsChildNode');
# Line 385  sub _typeCheck2 { Line 480  sub _typeCheck2 {
480      return;      return;
481    }    }
482    
483      sub getDbName {
484        my $self = shift;
485        $self->_abstract_function('getDbName');
486        return;
487      }
488    
489      sub testAvailability {
490        my $self = shift;
491        $self->_abstract_function('testAvailability');
492        return;
493      }
494    
495      sub isConnected {
496        my $self = shift;
497        $self->_abstract_function('isConnected');
498        return;
499      }
500    
501      sub testDsn {
502        my $self = shift;
503        $self->_abstract_function('testDsn');
504        return;
505      }
506    
507  1;  1;
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed