/[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.7 by joko, Sun Nov 17 06:07:18 2002 UTC revision 1.16 by joko, Mon Jan 20 16:52:13 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.7  2002/11/17 06:07:18  joko  ##
11  #  + creating the handler is easier than proposed first - for now :-)  ##  $Log$
12  #  + sub testAvailability  ##  Revision 1.16  2003/01/20 16:52:13  joko
13  #  ##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
14  #  Revision 1.6  2002/11/09 01:04:58  joko  ##
15  #  + updated pod  ##  Revision 1.15  2003/01/19 03:12:59  joko
16  #  ##  + modified header
17  #  Revision 1.5  2002/10/29 19:24:18  joko  ##  - removed pod-documentation - now in 'Storage.pod'
18  #  - reduced logging  ##
19  #  + added some pod  ##  Revision 1.14  2002/12/19 16:27:59  joko
20  #  ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
21  #  Revision 1.4  2002/10/27 18:35:07  joko  ##
22  #  + added pod  ##  Revision 1.13  2002/12/17 21:54:12  joko
23  #  ##  + feature when using Tangram:
24  #  Revision 1.3  2002/10/25 11:40:37  joko  ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
25  #  + enhanced robustness  ##        + patched Tangram::Storage (jonen)
26  #  + more logging for debug-levels  ##        + enhanced Data::Storage::Schema::Tangram (joko)
27  #  + sub dropDb  ##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
28  #  ##    + how?
29  #  Revision 1.2  2002/10/17 00:04:29  joko  ##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
30  #  + sub createDb  ##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
31  #  + sub isConnected  ##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
32  #  + bugfixes regarding "deep recursion" stuff  ##
33  #  ##  Revision 1.12  2002/12/12 02:50:15  joko
34  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##  + this now (unfortunately) needs DBI for some helper functions
35  #  + new  ##  + TODO: these have to be refactored to another scope! (soon!)
36  #  ##
37  #################################  ##  Revision 1.11  2002/12/11 06:53:19  joko
38    ##  + updated pod
39  # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  ##
40  # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:  ##  Revision 1.10  2002/12/07 03:37:23  joko
41  #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file  ##  + updated pod
42    ##
43    ##  Revision 1.9  2002/12/01 22:15:45  joko
44    ##  - sub createDb: moved to handler
45    ##
46    ##  Revision 1.8  2002/11/29 04:48:23  joko
47    ##  + updated pod
48    ##
49    ##  Revision 1.7  2002/11/17 06:07:18  joko
50    ##  + creating the handler is easier than proposed first - for now :-)
51    ##  + sub testAvailability
52    ##
53    ##  Revision 1.6  2002/11/09 01:04:58  joko
54    ##  + updated pod
55    ##
56    ##  Revision 1.5  2002/10/29 19:24:18  joko
57    ##  - reduced logging
58    ##  + added some pod
59    ##
60    ##  Revision 1.4  2002/10/27 18:35:07  joko
61    ##  + added pod
62    ##
63    ##  Revision 1.3  2002/10/25 11:40:37  joko
64    ##  + enhanced robustness
65    ##  + more logging for debug-levels
66    ##  + sub dropDb
67    ##
68    ##  Revision 1.2  2002/10/17 00:04:29  joko
69    ##  + sub createDb
70    ##  + sub isConnected
71    ##  + bugfixes regarding "deep recursion" stuff
72    ##
73    ##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
74    ##  + new
75    ## ------------------------------------------------------------------------
76    
77    
78  BEGIN {  BEGIN {
79  $Data::Storage::VERSION = 0.01;    $Data::Storage::VERSION = 0.03;
80  }  }
81    
   
 =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/or this code for additional information.  
   
   
 =head1 REQUIREMENTS  
   
 For full functionality:  
   DBI              from CPAN  
   Tangram          from CPAN  
   Class::Tangram   from CPAN  
   MySQL::Diff      from http://adamspiers.org/computing/mysqldiff/  
   ... and all their dependencies  
   
 =cut  
   
 # The POD text continues at the end of the file.  
   
   
82  package Data::Storage;  package Data::Storage;
83    
84  use strict;  use strict;
85  use warnings;  use warnings;
86    
 use Data::Storage::Locator;  
87  use Data::Dumper;  use Data::Dumper;
88    # FIXME: wipe out!
89    use DBI;
90    
91    use Data::Storage::Locator;
92    use DesignPattern::Object;
93    
94    
95  # TODO: actually implement level (integrate with Log::Dispatch)  # TODO: actually implement level (integrate with Log::Dispatch)
96  my $TRACELEVEL = 0;  my $TRACELEVEL = 0;
# Line 112  sub new { Line 106  sub new {
106    my $arg_locator = shift;    my $arg_locator = shift;
107    my $arg_options = shift;    my $arg_options = shift;
108    
109      if (!$arg_locator) {
110        $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
111        return;
112      }
113    
114    #my $self = { STORAGEHANDLE => undef, @_ };    #my $self = { STORAGEHANDLE => undef, @_ };
115    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
116    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
# Line 126  sub AUTOLOAD { Line 125  sub AUTOLOAD {
125    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
126    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
127    #     - Deep recursion on anonymous subroutine at [...]    #     - Deep recursion on anonymous subroutine at [...]
128    # 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"
129        
130    my $self = shift;    my $self = shift;
131    our $AUTOLOAD;    our $AUTOLOAD;
# Line 139  sub AUTOLOAD { Line 138  sub AUTOLOAD {
138    
139    # advanced logging of AUTOLOAD calls ...    # advanced logging of AUTOLOAD calls ...
140    # ... nice but do it only when TRACING (TODO) is enabled    # ... nice but do it only when TRACING (TODO) is enabled
     if ($TRACELEVEL) {  
141        my $logstring = "";        my $logstring = "";
142        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
143        #print "count: ", $#_, "\n";        #print "count: ", $#_, "\n";
# Line 148  sub AUTOLOAD { Line 146  sub AUTOLOAD {
146        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
147        # TODO: only ok if logstring doesn't contain        # TODO: only ok if logstring doesn't contain
148        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
149        # but that would be way too specific as long as we don't have an abstract handler for this  ;)        # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
150        if ($TRACELEVEL) {
151        $logger->debug( $logstring );        $logger->debug( $logstring );
152        #print join('; ', @_);        #print join('; ', @_);
153      }      }
154            
155    # filtering AUTOLOAD calls    # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
156    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
     #print "_accessStorage\n";  
157      $self->_accessStorage();      $self->_accessStorage();
158      $self->{STORAGEHANDLE}->$method(@_);      if ($self->{STORAGEHANDLE}) {
159          return $self->{STORAGEHANDLE}->$method(@_);
160        } else {
161          $logger->critical( __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring );
162          return;
163        }
164    }    }
165        
166  }  }
# Line 190  sub _accessStorage { Line 193  sub _accessStorage {
193      $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );      $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
194    }    }
195    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
196      $self->_createStorageHandle();      return $self->_createStorageHandle();
197    }    }
198  }  }
199    
200    sub _createStorageHandle1 {
201      my $self = shift;
202      my $type = $self->{locator}->{type};
203      $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
204    
205      my $pkg = "Data::Storage::Handler::" . $type . "";
206      
207      # try to load perl module at runtime
208      my $evalstr = "use $pkg;";
209      eval($evalstr);
210      if ($@) {
211        $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
212        return;
213      }
214      
215      # build up some additional arguments to pass on
216      #my @args = %{$self->{locator}};
217      my @args = ();
218    
219      # - create new storage handle object
220      # - propagate arguments to handler
221      # - pass locator by reference to be able to store status- or meta-information in it
222      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
223    
224    }
225    
226  sub _createStorageHandle {  sub _createStorageHandle {
227    my $self = shift;    my $self = shift;
228    my $type = $self->{locator}->{type};    my $type = $self->{locator}->{type};
229    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
230    
231    #print Dumper($self);
232    #exit;
233    
234    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
235        
236    # try to load perl module at runtime    # try to load perl module at runtime
237    =pod
238    my $evalstr = "use $pkg;";    my $evalstr = "use $pkg;";
239    eval($evalstr);    eval($evalstr);
240    if ($@) {    if ($@) {
# Line 213  sub _createStorageHandle { Line 246  sub _createStorageHandle {
246    #my @args = %{$self->{locator}};    #my @args = %{$self->{locator}};
247    my @args = ();    my @args = ();
248    
249    # create new storage handle object, propagate arguments to handler    # - create new storage handle object
250    # pass locator by reference to be able to store status information in it    # - propagate arguments to handler
251      # - pass locator by reference to be able to store status- or meta-information in it
252    $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );    $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
253    =cut
254    
255      $self->{STORAGEHANDLE} = DesignPattern::Object->fromPackage( $pkg, locator => $self->{locator} );
256      return 1;
257    
258  }  }
259    
# Line 248  sub addLogDispatchHandler { Line 286  sub addLogDispatchHandler {
286  }  }
287    
288  sub removeLogDispatchHandler {  sub removeLogDispatchHandler {
289      my $self = shift;
290        my $self = shift;    my $name = shift;
291        my $name = shift;    #my $logger = shift;
292        #my $logger = shift;    $logger->remove($name);
   
       $logger->remove($name);  
   
293  }  }
294    
295    =pod
296  sub getDbName {  sub getDbName {
297    my $self = shift;    my $self = shift;
298    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
# Line 265  sub getDbName { Line 301  sub getDbName {
301    return $database_name;    return $database_name;
302  }  }
303    
 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->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );  
   }  
 }  
   
304  sub testAvailability {  sub testAvailability {
305    my $self = shift;    my $self = shift;
306    my $status = $self->testDsn();    my $status = $self->testDsn();
# Line 286  sub testAvailability { Line 308  sub testAvailability {
308    return $status;    return $status;
309  }  }
310    
311  sub createDb {  sub isConnected {
312    my $self = shift;    my $self = shift;
313    my $dsn = $self->{locator}->{dbi}->{dsn};    # TODO: REVIEW!
314      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;  
     
315  }  }
316    
317  sub dropDb {  sub testDsn {
318    my $self = shift;    my $self = shift;
319    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
320      my $result;
   $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );  
   
   $dsn =~ s/database=(.+?);//;  
   my $database_name = $1;  
   
   my $ok;  
     
321    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
322                                                        PrintError => 0,                                                        PrintError => 0,
323                                                        } ) ) {                                                        } ) ) {
324      if ($database_name) {      
325        if ($dbh->do("DROP DATABASE $database_name;")) {      # TODO: REVIEW
         $ok = 1;  
       }  
     }  
326      $dbh->disconnect();      $dbh->disconnect();
327        
328        return 1;
329      } else {
330        $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
331    }    }
     
   return $ok;  
 }  
   
 sub isConnected {  
   my $self = shift;  
   return 1 if $self->{STORAGEHANDLE};  
332  }  }
333    =cut
334    
335  1;  1;
336  __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 for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,  
 Sam Vilain for Class::Tangram, Adam Spiers for MySQL::Diff and all contributors.  
   
   
 =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 pre-alpha stage.  
   And loosing data by being able to modify and redeploy schemas easily is definitely quite easy.  
     
   As we can see, creations of Classes and new Class variables is handled  
   automatically and this is believed to be the most common case under normal circumstances.  
   
   
 =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 programmers.  
   - Add some more handlers:  
     - look at DBD::CSV, Text::CSV, XML::CSV, XML::Excel  
   - Add some more locations/locators:  
     - PerlDAV: http://www.webdav.org/perldav/  
   - Move to t3, use InCASE  
   
   
 =head3 Links:  
   
   Specs:  
     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  
   
   CASE Tools:  
     Rational Rose (commercial): http://www.rational.com/products/rose/  
     Together (commercial): http://www.oi.com/products/controlcenter/index.jsp  
     InCASE - Tangram-based Universal Object Editor  
     Sybase PowerDesigner: http://www.sybase.com/powerdesigner  
     
   UML Editors:  
     Fujaba (free, university): http://www.fujaba.de/  
     ArgoUML (free): http://argouml.tigris.org/  
     Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3  
     Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html  
     Metamill (commercial): http://www.metamill.com/  
     Violet (university, research, education): http://www.horstmann.com/violet/  
     PyUt (free): http://pyut.sourceforge.net/  
     (Dia (free): http://www.lysator.liu.se/~alla/dia/)  
     UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html  
     Voodoo (free): http://voodoo.sourceforge.net/  
     Umbrello UML Modeller: http://uml.sourceforge.net/  
   
   UML Tools:  
     http://www.objectsbydesign.com/tools/umltools_byPrice.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  
   
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.16
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed