/[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.3 by joko, Fri Oct 25 11:40:37 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.3  2002/10/25 11:40:37  joko  ##
7  #  + enhanced robustness  ##    See COPYRIGHT section in pod text below for usage and distribution rights.
8  #  + more logging for debug-levels  ##
9  #  + sub dropDb  ## ------------------------------------------------------------------------
10  #  ##
11  #  Revision 1.2  2002/10/17 00:04:29  joko  ##  $Log$
12  #  + sub createDb  ##  Revision 1.17  2003/01/30 21:42:22  joko
13  #  + sub isConnected  ##  + minor update: renamed method
14  #  + bugfixes regarding "deep recursion" stuff  ##
15  #  ##  Revision 1.16  2003/01/20 16:52:13  joko
16  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
17  #  + new  ##
18  #  ##  Revision 1.15  2003/01/19 03:12:59  joko
19  #  ##  + modified header
20  #################################  ##  - removed pod-documentation - now in 'Storage.pod'
21    ##
22  # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  ##  Revision 1.14  2002/12/19 16:27:59  joko
23  # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:  ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
24  #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file  ##
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 DesignPattern::Object;
96    
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 37  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    
# Line 54  sub AUTOLOAD { Line 128  sub AUTOLOAD {
128    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
129    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
130    #     - Deep recursion on anonymous subroutine at [...]    #     - Deep recursion on anonymous subroutine at [...]
131    # we also might filter log messages caused by logging itself in "advanced logging of AUTOLOAD calls"    # 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;
# Line 65  sub AUTOLOAD { Line 139  sub AUTOLOAD {
139    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
140    $method =~ s/^.*:://;    $method =~ s/^.*:://;
141    
142    # advanced logging of AUTOLOAD calls    # advanced logging of AUTOLOAD calls ...
143      my $logstring = "";    # ... nice but do it only when TRACING (TODO) is enabled
144      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;        my $logstring = "";
145      #print "count: ", $#_, "\n";        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
146      #$logstring .= Dumper(@_) if ($#_ != -1);        #print "count: ", $#_, "\n";
147      my $tabcount = int( (80 - length($logstring)) / 10 );        #$logstring .= Dumper(@_) if ($#_ != -1);
148      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";        my $tabcount = int( (80 - length($logstring)) / 10 );
149      # TODO: only ok if logstring doesn't contain        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
150      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"        # TODO: only ok if logstring doesn't contain
151      # but that would be way too specific as long as we don't have an abstract handler for this  ;)        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
152      $logger->debug( $logstring );        # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
153        if ($TRACELEVEL) {
154    # filtering AUTOLOAD calls        $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 106  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->{locator}->{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};    my $type = $self->{locator}->{type};
208    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
209    
210    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
211        
212    # propagate args to handler    # try to load perl module at runtime
213    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    my $evalstr = "use $pkg;";
214    if ($type eq 'DBI') {    eval($evalstr);
215      use Data::Storage::Handler::DBI;    if ($@) {
216      #my @args = %{$self->{locator}->{dbi}};      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
217      my @args = %{$self->{locator}};      return;
     # create new storage handle  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
218    }    }
219    if ($type eq 'Tangram') {    
220      use Data::Storage::Handler::Tangram;    # build up some additional arguments to pass on
221      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );    #my @args = %{$self->{locator}};
222      #my @args = %{$self->{locator}->{dbi}};    my @args = ();
223      my @args = %{$self->{locator}};  
224      # create new storage handle    # - create new storage handle object
225      $self->{STORAGEHANDLE} = $pkg->new( @args );    # - 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      #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();  }
230      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();  
231    sub _createStorageHandle {
232      my $self = shift;
233      my $type = $self->{locator}->{type};
234      $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
235    
236    #print Dumper($self);
237    #exit;
238    
239      my $pkg = "Data::Storage::Handler::" . $type . "";
240      
241      # try to load perl module at runtime
242    =pod
243      my $evalstr = "use $pkg;";
244      eval($evalstr);
245      if ($@) {
246        $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
247        return;
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 175  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 192  sub getDbName { Line 306  sub getDbName {
306    return $database_name;    return $database_name;
307  }  }
308    
309  sub testDsn {  sub testAvailability {
310    my $self = shift;    my $self = shift;
311    my $dsn = $self->{locator}->{dbi}->{dsn};    my $status = $self->testDsn();
312    my $result;    $self->{locator}->{status}->{available} = $status;
313    if ( my $dbh = DBI->connect($dsn, '', '', {    return $status;
                                                       PrintError => 0,  
                                                       } ) ) {  
     $dbh->disconnect();  
     return 1;  
   } else {  
     $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );  
   }  
314  }  }
315    
316  sub createDb {  sub isConnected {
317    my $self = shift;    my $self = shift;
318    my $dsn = $self->{locator}->{dbi}->{dsn};    # TODO: REVIEW!
319      return 1 if $self->{STORAGEHANDLE};
   $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );  
   
   $dsn =~ s/database=(.+?);//;  
   my $database_name = $1;  
   
   my $ok;  
     
   if ( my $dbh = DBI->connect($dsn, '', '', {  
                                                       PrintError => 0,  
                                                       } ) ) {  
     if ($database_name) {  
       if ($dbh->do("CREATE DATABASE $database_name;")) {  
         $ok = 1;  
       }  
     }  
     $dbh->disconnect();  
   }  
     
   return $ok;  
     
320  }  }
321    
322  sub dropDb {  sub testDsn {
323    my $self = shift;    my $self = shift;
324    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
325      my $result;
   $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );  
   
   $dsn =~ s/database=(.+?);//;  
   my $database_name = $1;  
   
   my $ok;  
     
326    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
327                                                        PrintError => 0,                                                        PrintError => 0,
328                                                        } ) ) {                                                        } ) ) {
329      if ($database_name) {      
330        if ($dbh->do("DROP DATABASE $database_name;")) {      # TODO: REVIEW
         $ok = 1;  
       }  
     }  
331      $dbh->disconnect();      $dbh->disconnect();
332        
333        return 1;
334      } else {
335        $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
336    }    }
     
   return $ok;  
 }  
   
 sub isConnected {  
   my $self = shift;  
   return 1 if $self->{STORAGEHANDLE};  
337  }  }
338    =cut
339    
 1;  
340    1;
341    __END__
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.17
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed