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

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

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

revision 1.1 by cvsjoko, Thu Oct 10 03:43:12 2002 UTC revision 1.20 by joko, Wed Jun 25 22:51:51 2003 UTC
# Line 1  Line 1 
1  #################################  ## ------------------------------------------------------------------------
2  #  ##
3  #  $Id$  ##    $Id$
4  #  ##
5  #  $Log$  ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
6  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##
7  #  + new  ##    See COPYRIGHT section in pod text below for usage and distribution rights.
8  #  ##
9  #  ## ------------------------------------------------------------------------
10  #################################  ##
11    ##  $Log$
12    ##  Revision 1.20  2003/06/25 22:51:51  joko
13    ##  + sub get_locator_type & Co.
14    ##
15    ##  Revision 1.19  2003/02/18 19:22:11  joko
16    ##  + fixed logging
17    ##
18    ##  Revision 1.18  2003/01/30 22:12:17  joko
19    ##  - removed/refactored old code: ->Data::Storage::Handler::Tangram|DBI
20    ##
21    ##  Revision 1.17  2003/01/30 21:42:22  joko
22    ##  + minor update: renamed method
23    ##
24    ##  Revision 1.16  2003/01/20 16:52:13  joko
25    ##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
26    ##
27    ##  Revision 1.15  2003/01/19 03:12:59  joko
28    ##  + modified header
29    ##  - removed pod-documentation - now in 'Storage.pod'
30    ##
31    ##  Revision 1.14  2002/12/19 16:27:59  joko
32    ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
33    ##
34    ##  Revision 1.13  2002/12/17 21:54:12  joko
35    ##  + feature when using Tangram:
36    ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
37    ##        + patched Tangram::Storage (jonen)
38    ##        + enhanced Data::Storage::Schema::Tangram (joko)
39    ##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
40    ##    + how?
41    ##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
42    ##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
43    ##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
44    ##
45    ##  Revision 1.12  2002/12/12 02:50:15  joko
46    ##  + this now (unfortunately) needs DBI for some helper functions
47    ##  + TODO: these have to be refactored to another scope! (soon!)
48    ##
49    ##  Revision 1.11  2002/12/11 06:53:19  joko
50    ##  + updated pod
51    ##
52    ##  Revision 1.10  2002/12/07 03:37:23  joko
53    ##  + updated pod
54    ##
55    ##  Revision 1.9  2002/12/01 22:15:45  joko
56    ##  - sub createDb: moved to handler
57    ##
58    ##  Revision 1.8  2002/11/29 04:48:23  joko
59    ##  + updated pod
60    ##
61    ##  Revision 1.7  2002/11/17 06:07:18  joko
62    ##  + creating the handler is easier than proposed first - for now :-)
63    ##  + sub testAvailability
64    ##
65    ##  Revision 1.6  2002/11/09 01:04:58  joko
66    ##  + updated pod
67    ##
68    ##  Revision 1.5  2002/10/29 19:24:18  joko
69    ##  - reduced logging
70    ##  + added some pod
71    ##
72    ##  Revision 1.4  2002/10/27 18:35:07  joko
73    ##  + added pod
74    ##
75    ##  Revision 1.3  2002/10/25 11:40:37  joko
76    ##  + enhanced robustness
77    ##  + more logging for debug-levels
78    ##  + sub dropDb
79    ##
80    ##  Revision 1.2  2002/10/17 00:04:29  joko
81    ##  + sub createDb
82    ##  + sub isConnected
83    ##  + bugfixes regarding "deep recursion" stuff
84    ##
85    ##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
86    ##  + new
87    ## ------------------------------------------------------------------------
88    
89    
90    BEGIN {
91      $Data::Storage::VERSION = 0.03;
92    }
93    
94  package Data::Storage;  package Data::Storage;
95    
96  use strict;  use strict;
97  use warnings;  use warnings;
98    
99    use Data::Dumper;
100    # FIXME: wipe out!
101    use DBI;
102    
103  use Data::Storage::Locator;  use Data::Storage::Locator;
104  use Data::Storage::Handler::DBI;  use DesignPattern::Object;
105  use Data::Storage::Handler::Tangram;  
106    
107    # TODO: actually implement level (integrate with Log::Dispatch)
108    my $TRACELEVEL = 0;
109    
110  # get logger instance  # get logger instance
111  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 25  sub new { Line 114  sub new {
114    my $invocant = shift;    my $invocant = shift;
115    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
116    #my @args = normalizeArgs(@_);    #my @args = normalizeArgs(@_);
117      
118    my $arg_locator = shift;    my $arg_locator = shift;
119    my $arg_options = shift;    my $arg_options = shift;
120      #my @args = @_;
121      #@args ||= ();
122    
123      if (!$arg_locator) {
124        $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
125        return;
126      }
127        
128      #print Dumper($arg_locator);
129    
130    #my $self = { STORAGEHANDLE => undef, @_ };    #my $self = { STORAGEHANDLE => undef, @_ };
131    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
132    $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
133      $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new()" );
134    return bless $self, $class;    return bless $self, $class;
135  }  }
136    
137  sub AUTOLOAD {  sub AUTOLOAD {
138        
139      # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
140      # some sophisticated handling and filtering is needed to avoid things like
141      #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
142      #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
143      #     - Deep recursion on anonymous subroutine at [...]
144      # we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
145      
146    my $self = shift;    my $self = shift;
147    our $AUTOLOAD;    our $AUTOLOAD;
148        
# Line 46  sub AUTOLOAD { Line 152  sub AUTOLOAD {
152    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
153    $method =~ s/^.*:://;    $method =~ s/^.*:://;
154    
155    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)" . " (AUTOLOAD)" );    #print __PACKAGE__, "\n";
156      #print $method, "\n";
157      #print $self->{locator}, "\n";
158      
159      my $locator_type = $self->get_locator_type();
160    
161      # advanced logging of AUTOLOAD calls ...
162      # ... nice but do it only when TRACING (TODO) is enabled
163          my $logstring = "";
164          $logstring .= __PACKAGE__ . "[$locator_type]" . "->" . $method;
165          #print "count: ", $#_, "\n";
166          #$logstring .= Dumper(@_) if ($#_ != -1);
167          my $tabcount = int( (80 - length($logstring)) / 10 );
168          $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
169          # TODO: only ok if logstring doesn't contain
170          #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
171          # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
172        if ($TRACELEVEL) {
173          $logger->debug( $logstring );
174          #print join('; ', @_);
175        }
176        
177      # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
178    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
179      $self->_accessStorage();      #print "=== FILTER!", "\n";
180      $self->{STORAGEHANDLE}->$method(@_);      $self->_accessStorageHandle();
181        if ($self->{STORAGEHANDLE}) {
182          return $self->{STORAGEHANDLE}->$method(@_);
183        } else {
184          my $msg = __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring;
185          $logger->critical( $msg ) if $logger;
186          print STDERR $msg if not $logger;
187          return;
188        }
189    }    }
190        
191  }  }
# Line 67  sub _filter_AUTOLOAD { Line 202  sub _filter_AUTOLOAD {
202  }  }
203    
204    
205  sub normalizeArgs {  sub _accessStorageHandle {
206    my %args = @_;    my $self = shift;
207    if (!$args{dsn} && $args{meta}{dsn}) {    # TODO: to some tracelevel!
208      $args{dsn} = $args{meta}{dsn};    #print "=========== _accessStorage", "\n";
209      if ($TRACELEVEL) {
210        $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorageHandle()" );
211      }
212      if (!$self->{STORAGEHANDLE}) {
213        return $self->_createStorageHandle();
214    }    }
   my @result = %args;  
   return @result;  
215  }  }
216    
217  sub _accessStorage {  sub _createStorageHandle1 {
218    my $self = shift;    my $self = shift;
219    # TODO: to some tracelevel!    my $type = $self->{locator}->{type};
220    #$logger->debug( __PACKAGE__ .  "[$self->{type}]" . "->_accessStorage()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
221    if (!$self->{STORAGEHANDLE}) {  
222      $self->_createStorageHandle();    my $pkg = "Data::Storage::Handler::" . $type . "";
223      
224      # try to load perl module at runtime
225      my $evalstr = "use $pkg;";
226      eval($evalstr);
227      if ($@) {
228        $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
229        return;
230    }    }
231      
232      # build up some additional arguments to pass on
233      #my @args = %{$self->{locator}};
234      my @args = ();
235    
236      # - create new storage handle object
237      # - propagate arguments to handler
238      # - pass locator by reference to be able to store status- or meta-information in it
239      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
240    
241  }  }
242    
243  sub _createStorageHandle {  sub _createStorageHandle {
244    my $self = shift;    my $self = shift;
245      
246    my $type = $self->{locator}->{type};    # 2003-06-18: protection against storagehandles w/o locators
247      return if not defined $self->{locator};
248      
249      my $type = $self->get_locator_type();
250    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
251    
252    #print Dumper($self);
253    #exit;
254    
255    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
256        
257    # propagate args to handler    # try to load perl module at runtime
258    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)  =pod
259    if ($type eq 'DBI') {    my $evalstr = "use $pkg;";
260      #my @args = %{$self->{locator}->{dbi}};    eval($evalstr);
261      my @args = %{$self->{locator}};    if ($@) {
262      $self->{STORAGEHANDLE} = $pkg->new( @args );      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
263    }      return;
   if ($type eq 'Tangram') {  
     #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );  
     #my @args = %{$self->{locator}->{dbi}};  
     my @args = %{$self->{locator}};  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
     #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();  
     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();  
264    }    }
265        
266      # build up some additional arguments to pass on
267      #my @args = %{$self->{locator}};
268      my @args = ();
269    
270      # - create new storage handle object
271      # - propagate arguments to handler
272      # - pass locator by reference to be able to store status- or meta-information in it
273      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
274    =cut
275    
276      $self->{STORAGEHANDLE} = DesignPattern::Object->fromPackage( $pkg, locator => $self->{locator} );
277      return 1;
278    
279  }  }
280    
281  sub addLogDispatchHandler {  sub addLogDispatchHandler {
# Line 116  sub addLogDispatchHandler { Line 283  sub addLogDispatchHandler {
283        my $self = shift;        my $self = shift;
284        my $name = shift;        my $name = shift;
285        my $package = shift;        my $package = shift;
286        my $logger = shift;        my $logger1 = shift;
287        my $objectCreator = shift;        my $objectCreator = shift;
288                
289        #$logger->add( Log::Dispatch::Tangram->new( name => $name,        #$logger->add( Log::Dispatch::Tangram->new( name => $name,
# Line 140  sub addLogDispatchHandler { Line 307  sub addLogDispatchHandler {
307  }  }
308    
309  sub removeLogDispatchHandler {  sub removeLogDispatchHandler {
   
       my $self = shift;  
       my $name = shift;  
       my $logger = shift;  
   
       $logger->remove($name);  
   
 }  
   
 sub getDbName {  
310    my $self = shift;    my $self = shift;
311    my $dsn = $self->{locator}->{dbi}->{dsn};    my $name = shift;
312    $dsn =~ m/database=(.+?);/;    #my $logger = shift;
313    my $database_name = $1;    $logger->remove($name);
   return $database_name;  
314  }  }
315    
316  sub testDsn {  sub get_locator_type {
317    my $self = shift;    my $self = shift;
318    my $dsn = $self->{locator}->{dbi}->{dsn};    my $locator_type = '';
319    my $result;    $locator_type = $self->{locator}->{type} if defined $self->{locator};
320    if ( my $dbh = DBI->connect($dsn, '', '', {    return $locator_type;
                                                       PrintError => 0,  
                                                       } ) ) {  
     $dbh->disconnect();  
     return 1;  
   } else {  
     $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . DBI::errstr );  
   }  
321  }  }
322    
 1;  
323    1;
324    __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.20
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed