/[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.15 by joko, Sun Jan 19 03:12:59 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.15  2003/01/19 03:12:59  joko
13  #  Revision 1.3  2002/10/25 11:40:37  joko  ##  + modified header
14  #  + enhanced robustness  ##  - removed pod-documentation - now in 'Storage.pod'
15  #  + more logging for debug-levels  ##
16  #  + sub dropDb  ##  Revision 1.14  2002/12/19 16:27:59  joko
17  #  ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
18  #  Revision 1.2  2002/10/17 00:04:29  joko  ##
19  #  + sub createDb  ##  Revision 1.13  2002/12/17 21:54:12  joko
20  #  + sub isConnected  ##  + feature when using Tangram:
21  #  + bugfixes regarding "deep recursion" stuff  ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
22  #  ##        + patched Tangram::Storage (jonen)
23  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  ##        + enhanced Data::Storage::Schema::Tangram (joko)
24  #  + new  ##        + 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  # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  ##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
29  # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:  ##
30  #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file  ##  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 {  BEGIN {
76  $Data::Storage::VERSION = 0.01;    $Data::Storage::VERSION = 0.03;
77  }  }
78    
 =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.  
   
   
79  package Data::Storage;  package Data::Storage;
80    
81  use strict;  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 83  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 100  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 111  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 155  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 163  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 221  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 238  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    
290  1;  1;
291  __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.15
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed