/[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.4 by joko, Sun Oct 27 18:35:07 2002 UTC revision 1.20 by joko, Wed Jun 25 22:51:51 2003 UTC
# Line 1  Line 1 
1  # $Id$  ## ------------------------------------------------------------------------
2  #  ##
3  # Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>  ##    $Id$
4  #  ##
5  # See COPYRIGHT section in pod text below for usage and distribution rights.  ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
6  #  ##
7  #################################  ##    See COPYRIGHT section in pod text below for usage and distribution rights.
8  #  ##
9  #  $Log$  ## ------------------------------------------------------------------------
10  #  Revision 1.4  2002/10/27 18:35:07  joko  ##
11  #  + added pod  ##  $Log$
12  #  ##  Revision 1.20  2003/06/25 22:51:51  joko
13  #  Revision 1.3  2002/10/25 11:40:37  joko  ##  + sub get_locator_type & Co.
14  #  + enhanced robustness  ##
15  #  + more logging for debug-levels  ##  Revision 1.19  2003/02/18 19:22:11  joko
16  #  + sub dropDb  ##  + fixed logging
17  #  ##
18  #  Revision 1.2  2002/10/17 00:04:29  joko  ##  Revision 1.18  2003/01/30 22:12:17  joko
19  #  + sub createDb  ##  - removed/refactored old code: ->Data::Storage::Handler::Tangram|DBI
20  #  + sub isConnected  ##
21  #  + bugfixes regarding "deep recursion" stuff  ##  Revision 1.17  2003/01/30 21:42:22  joko
22  #  ##  + minor update: renamed method
23  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##
24  #  + new  ##  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  # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  ##  + modified header
29  # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:  ##  - removed pod-documentation - now in 'Storage.pod'
30  #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file  ##
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 {  BEGIN {
91  $Data::Storage::VERSION = 0.01;    $Data::Storage::VERSION = 0.03;
92  }  }
93    
 =head1 NAME  
   
 Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way  
   
 =head1 SYNOPSIS  
   
   ... the basic way:  
   
   
   ... via inheritance:  
     
     use Data::Storage;  
     my $proxyObj = new HttpProxy;  
     $proxyObj->{url} = $url;  
     $proxyObj->{payload} = $content;  
     $self->{storage}->insert($proxyObj);  
       
     use Data::Storage;  
     my $proxyObj = HttpProxy->new(  
       url => $url,  
       payload => $content,  
     );  
     $self->{storage}->insert($proxyObj);  
   
   
 =head2 NOTE  
   
 This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks.  
 Please look at their documentation and this code for additional information.  
   
   
 =cut  
   
 # The POD text continues at the end of the file.  
   
   
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 DesignPattern::Object;
105    
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 83  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    
# Line 100  sub AUTOLOAD { Line 141  sub AUTOLOAD {
141    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
142    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
143    #     - Deep recursion on anonymous subroutine at [...]    #     - Deep recursion on anonymous subroutine at [...]
144    # 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"
145        
146    my $self = shift;    my $self = shift;
147    our $AUTOLOAD;    our $AUTOLOAD;
# Line 111  sub AUTOLOAD { Line 152  sub AUTOLOAD {
152    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
153    $method =~ s/^.*:://;    $method =~ s/^.*:://;
154    
155    # advanced logging of AUTOLOAD calls    #print __PACKAGE__, "\n";
156      my $logstring = "";    #print $method, "\n";
157      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;    #print $self->{locator}, "\n";
158      #print "count: ", $#_, "\n";    
159      #$logstring .= Dumper(@_) if ($#_ != -1);    my $locator_type = $self->get_locator_type();
160      my $tabcount = int( (80 - length($logstring)) / 10 );  
161      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";    # advanced logging of AUTOLOAD calls ...
162      # TODO: only ok if logstring doesn't contain    # ... nice but do it only when TRACING (TODO) is enabled
163      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"        my $logstring = "";
164      # but that would be way too specific as long as we don't have an abstract handler for this  ;)        $logstring .= __PACKAGE__ . "[$locator_type]" . "->" . $method;
165      $logger->debug( $logstring );        #print "count: ", $#_, "\n";
166          #$logstring .= Dumper(@_) if ($#_ != -1);
167    # filtering AUTOLOAD calls        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 143  sub _filter_AUTOLOAD { Line 202  sub _filter_AUTOLOAD {
202  }  }
203    
204    
205  sub normalizeArgs {  sub _accessStorageHandle {
   my %args = @_;  
   if (!$args{dsn} && $args{meta}{dsn}) {  
     $args{dsn} = $args{meta}{dsn};  
   }  
   my @result = %args;  
   return @result;  
 }  
   
 sub _accessStorage {  
206    my $self = shift;    my $self = shift;
207    # TODO: to some tracelevel!    # TODO: to some tracelevel!
208    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );    #print "=========== _accessStorage", "\n";
209      if ($TRACELEVEL) {
210        $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorageHandle()" );
211      }
212    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
213      $self->_createStorageHandle();      return $self->_createStorageHandle();
214    }    }
215  }  }
216    
217  sub _createStorageHandle {  sub _createStorageHandle1 {
218    my $self = shift;    my $self = shift;
   
219    my $type = $self->{locator}->{type};    my $type = $self->{locator}->{type};
220    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
221    
222    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
223        
224    # propagate args to handler    # try to load perl module at runtime
225    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    my $evalstr = "use $pkg;";
226    if ($type eq 'DBI') {    eval($evalstr);
227      use Data::Storage::Handler::DBI;    if ($@) {
228      #my @args = %{$self->{locator}->{dbi}};      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
229      my @args = %{$self->{locator}};      return;
     # create new storage handle  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
230    }    }
231    if ($type eq 'Tangram') {    
232      use Data::Storage::Handler::Tangram;    # build up some additional arguments to pass on
233      #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );    #my @args = %{$self->{locator}};
234      #my @args = %{$self->{locator}->{dbi}};    my @args = ();
235      my @args = %{$self->{locator}};  
236      # create new storage handle    # - create new storage handle object
237      $self->{STORAGEHANDLE} = $pkg->new( @args );    # - 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 {
244      my $self = shift;
245      
246      # 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()" );
251    
252      #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();  #print Dumper($self);
253      #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();  #exit;
254    
255      my $pkg = "Data::Storage::Handler::" . $type . "";
256      
257      # try to load perl module at runtime
258    =pod
259      my $evalstr = "use $pkg;";
260      eval($evalstr);
261      if ($@) {
262        $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
263        return;
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 221  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 {  
   my $self = shift;  
   my $dsn = $self->{locator}->{dbi}->{dsn};  
   $dsn =~ m/database=(.+?);/;  
   my $database_name = $1;  
   return $database_name;  
 }  
   
 sub testDsn {  
   my $self = shift;  
   my $dsn = $self->{locator}->{dbi}->{dsn};  
   my $result;  
   if ( my $dbh = DBI->connect($dsn, '', '', {  
                                                       PrintError => 0,  
                                                       } ) ) {  
     $dbh->disconnect();  
     return 1;  
   } else {  
     $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );  
   }  
 }  
   
 sub createDb {  
   my $self = shift;  
   my $dsn = $self->{locator}->{dbi}->{dsn};  
   
   $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;  
     
 }  
   
 sub dropDb {  
310    my $self = shift;    my $self = shift;
311    my $dsn = $self->{locator}->{dbi}->{dsn};    my $name = shift;
312      #my $logger = shift;
313    $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );    $logger->remove($name);
   
   $dsn =~ s/database=(.+?);//;  
   my $database_name = $1;  
   
   my $ok;  
     
   if ( my $dbh = DBI->connect($dsn, '', '', {  
                                                       PrintError => 0,  
                                                       } ) ) {  
     if ($database_name) {  
       if ($dbh->do("DROP DATABASE $database_name;")) {  
         $ok = 1;  
       }  
     }  
     $dbh->disconnect();  
   }  
     
   return $ok;  
314  }  }
315    
316  sub isConnected {  sub get_locator_type {
317    my $self = shift;    my $self = shift;
318    return 1 if $self->{STORAGEHANDLE};    my $locator_type = '';
319      $locator_type = $self->{locator}->{type} if defined $self->{locator};
320      return $locator_type;
321  }  }
322    
323  1;  1;
324  __END__  __END__
   
   
 =head1 DESCRIPTION  
   
 Data::Storage is module for a accessing various "data structures" stored inside  
 various "data containers". It sits on top of DBI and/or Tangram.  
   
   
 =head1 AUTHORS / COPYRIGHT  
   
 The Data::Storage module is Copyright (c) 2002 Andreas Motl.  
 All rights reserved.  
   
 You may distribute it under the terms of either the GNU General Public  
 License or the Artistic License, as specified in the Perl README file.  
   
   
 =head1 ACKNOWLEDGEMENTS  
   
 Larry Wall and the C<perl5-porters> for Perl,  
 Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,  
 Sam Vilain for Class::Tangram.  
   
   
 =head1 SUPPORT / WARRANTY  
   
 Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.  
   
   
 =head1 TODO  
   
   
 =head2 Handle the following errors/cases:  
   
 =head3 "DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"  
   
     ... occours when operating on object-attributes not introduced yet:  
     this should be detected and appended/replaced through:  
     "Schema-Error detected, maybe (just) an inconsistency.  
     Please check if your declaration in schema-module "a" matches structure in database "b" or try to run"  
     db_setup.pl --dbkey=import --action=deploy  
   
 =head3 Compare schema (structure diff) with database ...  
   
   ... when issuing "db_setup.pl --dbkey=import --action=deploy"  
   on a database with an already deployed schema, use an additional "--update" then  
   to lift the schema inside the database to the current declared schema.  
   You will have to approve removals and changes on field-level while  
   new objects and new fields are introduced silently without any interaction needed.  
   In future versions there may be additional options to control silent processing of  
   removals and changes.  
   See this CRUD-table applying to the actions occouring on Classes and Class variables when deploying schemas,  
   don't mix this up with CRUD-actions on Objects, these are already handled by (e.g.) Tangram itself.  
   Classes:  
     C create    ->  yes, handled automatically  
     R retrieve  ->  no, not subject of this aspect since it is about deployment only  
     U update    ->  yes, automatically for Class meta-attributes, yes/no for Class variables (look at the rules down here)  
     D delete    ->  yes, just by user-interaction  
   Class variables:  
     C create    ->  yes, handled automatically  
     R retrieve  ->  no, not subject of this aspect since it is about deployment only  
     U update    ->  yes, just by user-interaction; maybe automatically if it can be determined that data wouldn't be lost  
     D delete    ->  yes, just by user-interaction  
   It's all about not to be able to loose data simply while this is in alpha stage.  
   
   
 =head2 Introduce some features:  
   
   Get this stuff together with UML (Unified Modeling Language) and/or standards from ODMG.  
   Make it possible to load/save schemas in XMI (XML Metadata Interchange),  
   which seems to be most commonly used today, perhaps handle objects with OIFML.  
   Integrate/bundle this with a web-/html-based UML modeling tool or  
   some other interesting stuff like the "Co-operative UML Editor" from Uni Darmstadt. (web-/java-based)  
   Enable Round Trip Engineering. Keep code and diagrams in sync. Don't annoy/bother the programmer.  
   
   
 =head3 Links:  
   
     UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf  
     XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf  
     XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf  
     ODMG: http://odmg.org/  
     OIFML: http://odmg.org/library/readingroom/oifml.pdf  
     Co-operative UML Editor: http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html  
   
   further readings:  
     http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N  
     http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf  
     http://www.enhyper.com/src/documentation/  
     http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf  
     http://citeseer.nj.nec.com/vilain00diagrammatic.html  
     http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp  
   
   maybe useful for / to be integrated with:  
     ArapXML: http://xml.coverpages.org/ni2001-09-24-b.html  
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.20
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed