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