/[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.15 by joko, Sun Jan 19 03:12:59 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.15  2003/01/19 03:12:59  joko
13  #  + sub isConnected  ##  + modified header
14  #  + bugfixes regarding "deep recursion" stuff  ##  - removed pod-documentation - now in 'Storage.pod'
15  #  ##
16  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##  Revision 1.14  2002/12/19 16:27:59  joko
17  #  + new  ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
18  #  ##
19  #  ##  Revision 1.13  2002/12/17 21:54:12  joko
20  #################################  ##  + feature when using Tangram:
21    ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
22  # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  ##        + patched Tangram::Storage (jonen)
23  # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:  ##        + enhanced Data::Storage::Schema::Tangram (joko)
24  #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file  ##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
25    ##    + how?
26    ##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
27    ##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
28    ##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
29    ##
30    ##  Revision 1.12  2002/12/12 02:50:15  joko
31    ##  + this now (unfortunately) needs DBI for some helper functions
32    ##  + TODO: these have to be refactored to another scope! (soon!)
33    ##
34    ##  Revision 1.11  2002/12/11 06:53:19  joko
35    ##  + updated pod
36    ##
37    ##  Revision 1.10  2002/12/07 03:37:23  joko
38    ##  + updated pod
39    ##
40    ##  Revision 1.9  2002/12/01 22:15:45  joko
41    ##  - sub createDb: moved to handler
42    ##
43    ##  Revision 1.8  2002/11/29 04:48:23  joko
44    ##  + updated pod
45    ##
46    ##  Revision 1.7  2002/11/17 06:07:18  joko
47    ##  + creating the handler is easier than proposed first - for now :-)
48    ##  + sub testAvailability
49    ##
50    ##  Revision 1.6  2002/11/09 01:04:58  joko
51    ##  + updated pod
52    ##
53    ##  Revision 1.5  2002/10/29 19:24:18  joko
54    ##  - reduced logging
55    ##  + added some pod
56    ##
57    ##  Revision 1.4  2002/10/27 18:35:07  joko
58    ##  + added pod
59    ##
60    ##  Revision 1.3  2002/10/25 11:40:37  joko
61    ##  + enhanced robustness
62    ##  + more logging for debug-levels
63    ##  + sub dropDb
64    ##
65    ##  Revision 1.2  2002/10/17 00:04:29  joko
66    ##  + sub createDb
67    ##  + sub isConnected
68    ##  + bugfixes regarding "deep recursion" stuff
69    ##
70    ##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
71    ##  + new
72    ## ------------------------------------------------------------------------
73    
74    
75    BEGIN {
76      $Data::Storage::VERSION = 0.03;
77    }
78    
79  package Data::Storage;  package Data::Storage;
80    
# Line 29  use strict; Line 82  use strict;
82  use warnings;  use warnings;
83    
84  use Data::Storage::Locator;  use Data::Storage::Locator;
85    use Data::Dumper;
86    
87    # TODO: wipe out!
88    use DBI;
89    
90    # TODO: actually implement level (integrate with Log::Dispatch)
91    my $TRACELEVEL = 0;
92    
93  # get logger instance  # get logger instance
94  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 37  sub new { Line 97  sub new {
97    my $invocant = shift;    my $invocant = shift;
98    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
99    #my @args = normalizeArgs(@_);    #my @args = normalizeArgs(@_);
100      
101    my $arg_locator = shift;    my $arg_locator = shift;
102    my $arg_options = shift;    my $arg_options = shift;
103      
104      if (!$arg_locator) {
105        $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
106        return;
107      }
108    
109    #my $self = { STORAGEHANDLE => undef, @_ };    #my $self = { STORAGEHANDLE => undef, @_ };
110    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
111    $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
112      $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
113    return bless $self, $class;    return bless $self, $class;
114  }  }
115    
# Line 54  sub AUTOLOAD { Line 120  sub AUTOLOAD {
120    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
121    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
122    #     - Deep recursion on anonymous subroutine at [...]    #     - Deep recursion on anonymous subroutine at [...]
123    # 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"
124        
125    my $self = shift;    my $self = shift;
126    our $AUTOLOAD;    our $AUTOLOAD;
# Line 65  sub AUTOLOAD { Line 131  sub AUTOLOAD {
131    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
132    $method =~ s/^.*:://;    $method =~ s/^.*:://;
133    
134    # advanced logging of AUTOLOAD calls    # advanced logging of AUTOLOAD calls ...
135      my $logstring = "";    # ... nice but do it only when TRACING (TODO) is enabled
136      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;      if ($TRACELEVEL) {
137      #print "count: ", $#_, "\n";        my $logstring = "";
138      #$logstring .= Dumper(@_) if ($#_ != -1);        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
139      my $tabcount = int( (80 - length($logstring)) / 10 );        #print "count: ", $#_, "\n";
140      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";        #$logstring .= Dumper(@_) if ($#_ != -1);
141      # TODO: only ok if logstring doesn't contain        my $tabcount = int( (80 - length($logstring)) / 10 );
142      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
143      # but that would be way too specific as long as we don't have an abstract handler for this  ;)        # TODO: only ok if logstring doesn't contain
144      $logger->debug( $logstring );        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
145          # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
146    # filtering AUTOLOAD calls        $logger->debug( $logstring );
147          #print join('; ', @_);
148        }
149        
150      # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
151    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
152        #print "_accessStorage\n";
153      $self->_accessStorage();      $self->_accessStorage();
154      $self->{STORAGEHANDLE}->$method(@_);      return $self->{STORAGEHANDLE}->$method(@_);
155    }    }
156        
157  }  }
# Line 109  sub normalizeArgs { Line 180  sub normalizeArgs {
180  sub _accessStorage {  sub _accessStorage {
181    my $self = shift;    my $self = shift;
182    # TODO: to some tracelevel!    # TODO: to some tracelevel!
183    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );    if ($TRACELEVEL) {
184        $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
185      }
186    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
187      $self->_createStorageHandle();      $self->_createStorageHandle();
188    }    }
# Line 117  sub _accessStorage { Line 190  sub _accessStorage {
190    
191  sub _createStorageHandle {  sub _createStorageHandle {
192    my $self = shift;    my $self = shift;
   
193    my $type = $self->{locator}->{type};    my $type = $self->{locator}->{type};
194    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
195    
196    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
197        
198    # propagate args to handler    # try to load perl module at runtime
199    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    my $evalstr = "use $pkg;";
200    if ($type eq 'DBI') {    eval($evalstr);
201      use Data::Storage::Handler::DBI;    if ($@) {
202      #my @args = %{$self->{locator}->{dbi}};      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
203      my @args = %{$self->{locator}};      return;
     # create new storage handle  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
   }  
   if ($type eq 'Tangram') {  
     use Data::Storage::Handler::Tangram;  
     #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );  
     #my @args = %{$self->{locator}->{dbi}};  
     my @args = %{$self->{locator}};  
     # create new storage handle  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
   
     #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();  
     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();  
204    }    }
205        
206      # build up some additional arguments to pass on
207      #my @args = %{$self->{locator}};
208      my @args = ();
209    
210      # - create new storage handle object
211      # - propagate arguments to handler
212      # - pass locator by reference to be able to store status- or meta-information in it
213      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
214    
215  }  }
216    
217  sub addLogDispatchHandler {  sub addLogDispatchHandler {
# Line 175  sub addLogDispatchHandler { Line 243  sub addLogDispatchHandler {
243  }  }
244    
245  sub removeLogDispatchHandler {  sub removeLogDispatchHandler {
246      my $self = shift;
247        my $self = shift;    my $name = shift;
248        my $name = shift;    #my $logger = shift;
249        #my $logger = shift;    $logger->remove($name);
   
       $logger->remove($name);  
   
250  }  }
251    
252  sub getDbName {  sub getDbName {
# Line 192  sub getDbName { Line 257  sub getDbName {
257    return $database_name;    return $database_name;
258  }  }
259    
260  sub testDsn {  sub testAvailability {
261    my $self = shift;    my $self = shift;
262    my $dsn = $self->{locator}->{dbi}->{dsn};    my $status = $self->testDsn();
263    my $result;    $self->{locator}->{status}->{available} = $status;
264    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 );  
   }  
265  }  }
266    
267  sub createDb {  sub isConnected {
268    my $self = shift;    my $self = shift;
269    my $dsn = $self->{locator}->{dbi}->{dsn};    # TODO: REVIEW!
270      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;  
     
271  }  }
272    
273  sub dropDb {  sub testDsn {
274    my $self = shift;    my $self = shift;
275    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
276      my $result;
   $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );  
   
   $dsn =~ s/database=(.+?);//;  
   my $database_name = $1;  
   
   my $ok;  
     
277    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
278                                                        PrintError => 0,                                                        PrintError => 0,
279                                                        } ) ) {                                                        } ) ) {
280      if ($database_name) {      
281        if ($dbh->do("DROP DATABASE $database_name;")) {      # TODO: REVIEW
         $ok = 1;  
       }  
     }  
282      $dbh->disconnect();      $dbh->disconnect();
283        
284        return 1;
285      } else {
286        $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
287    }    }
     
   return $ok;  
 }  
   
 sub isConnected {  
   my $self = shift;  
   return 1 if $self->{STORAGEHANDLE};  
288  }  }
289    
 1;  
290    1;
291    __END__
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.15
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed