/[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.1 by cvsjoko, Thu Oct 10 03:43:12 2002 UTC revision 1.7 by joko, Sun Nov 17 06:07:18 2002 UTC
# Line 1  Line 1 
1  #################################  # $Id$
2    #
3    # Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
4  #  #
5  #  $Id$  # See COPYRIGHT section in pod text below for usage and distribution rights.
6    #
7    #################################
8  #  #
9  #  $Log$  #  $Log$
10    #  Revision 1.7  2002/11/17 06:07:18  joko
11    #  + creating the handler is easier than proposed first - for now :-)
12    #  + sub testAvailability
13    #
14    #  Revision 1.6  2002/11/09 01:04:58  joko
15    #  + updated pod
16    #
17    #  Revision 1.5  2002/10/29 19:24:18  joko
18    #  - reduced logging
19    #  + added some pod
20    #
21    #  Revision 1.4  2002/10/27 18:35:07  joko
22    #  + added pod
23    #
24    #  Revision 1.3  2002/10/25 11:40:37  joko
25    #  + enhanced robustness
26    #  + more logging for debug-levels
27    #  + sub dropDb
28    #
29    #  Revision 1.2  2002/10/17 00:04:29  joko
30    #  + sub createDb
31    #  + sub isConnected
32    #  + bugfixes regarding "deep recursion" stuff
33    #
34  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
35  #  + new  #  + new
36  #  #
 #  
37  #################################  #################################
38    
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:
41    #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
42    
43    BEGIN {
44    $Data::Storage::VERSION = 0.01;
45    }
46    
47    
48    =head1 NAME
49    
50    Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way
51    
52    =head1 SYNOPSIS
53    
54      ... the basic way:
55    
56    
57      ... via inheritance:
58      
59        use Data::Storage;
60        my $proxyObj = new HttpProxy;
61        $proxyObj->{url} = $url;
62        $proxyObj->{payload} = $content;
63        $self->{storage}->insert($proxyObj);
64        
65        use Data::Storage;
66        my $proxyObj = HttpProxy->new(
67          url => $url,
68          payload => $content,
69        );
70        $self->{storage}->insert($proxyObj);
71    
72    
73    =head2 NOTE
74    
75    This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks.
76    Please look at their documentation and/or this code for additional information.
77    
78    
79    =head1 REQUIREMENTS
80    
81    For full functionality:
82      DBI              from CPAN
83      Tangram          from CPAN
84      Class::Tangram   from CPAN
85      MySQL::Diff      from http://adamspiers.org/computing/mysqldiff/
86      ... and all their dependencies
87    
88    =cut
89    
90    # The POD text continues at the end of the file.
91    
92    
93  package Data::Storage;  package Data::Storage;
94    
95  use strict;  use strict;
96  use warnings;  use warnings;
97    
98  use Data::Storage::Locator;  use Data::Storage::Locator;
99  use Data::Storage::Handler::DBI;  use Data::Dumper;
100  use Data::Storage::Handler::Tangram;  
101    # TODO: actually implement level (integrate with Log::Dispatch)
102    my $TRACELEVEL = 0;
103    
104  # get logger instance  # get logger instance
105  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 25  sub new { Line 108  sub new {
108    my $invocant = shift;    my $invocant = shift;
109    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
110    #my @args = normalizeArgs(@_);    #my @args = normalizeArgs(@_);
111      
112    my $arg_locator = shift;    my $arg_locator = shift;
113    my $arg_options = shift;    my $arg_options = shift;
114      
115    #my $self = { STORAGEHANDLE => undef, @_ };    #my $self = { STORAGEHANDLE => undef, @_ };
116    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
117    $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
118      $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
119    return bless $self, $class;    return bless $self, $class;
120  }  }
121    
122  sub AUTOLOAD {  sub AUTOLOAD {
123        
124      # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
125      # some sophisticated handling and filtering is needed to avoid things like
126      #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
127      #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
128      #     - Deep recursion on anonymous subroutine at [...]
129      # we also might filter log messages caused by logging itself in "advanced logging of AUTOLOAD calls"
130      
131    my $self = shift;    my $self = shift;
132    our $AUTOLOAD;    our $AUTOLOAD;
133        
# Line 46  sub AUTOLOAD { Line 137  sub AUTOLOAD {
137    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
138    $method =~ s/^.*:://;    $method =~ s/^.*:://;
139    
140    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)" . " (AUTOLOAD)" );    # advanced logging of AUTOLOAD calls ...
141      # ... nice but do it only when TRACING (TODO) is enabled
142        if ($TRACELEVEL) {
143          my $logstring = "";
144          $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
145          #print "count: ", $#_, "\n";
146          #$logstring .= Dumper(@_) if ($#_ != -1);
147          my $tabcount = int( (80 - length($logstring)) / 10 );
148          $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
149          # TODO: only ok if logstring doesn't contain
150          #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
151          # but that would be way too specific as long as we don't have an abstract handler for this  ;)
152          $logger->debug( $logstring );
153          #print join('; ', @_);
154        }
155        
156      # filtering AUTOLOAD calls
157    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
158        #print "_accessStorage\n";
159      $self->_accessStorage();      $self->_accessStorage();
160      $self->{STORAGEHANDLE}->$method(@_);      $self->{STORAGEHANDLE}->$method(@_);
161    }    }
# Line 79  sub normalizeArgs { Line 186  sub normalizeArgs {
186  sub _accessStorage {  sub _accessStorage {
187    my $self = shift;    my $self = shift;
188    # TODO: to some tracelevel!    # TODO: to some tracelevel!
189    #$logger->debug( __PACKAGE__ .  "[$self->{type}]" . "->_accessStorage()" );    if ($TRACELEVEL) {
190        $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
191      }
192    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
193      $self->_createStorageHandle();      $self->_createStorageHandle();
194    }    }
# Line 87  sub _accessStorage { Line 196  sub _accessStorage {
196    
197  sub _createStorageHandle {  sub _createStorageHandle {
198    my $self = shift;    my $self = shift;
   
199    my $type = $self->{locator}->{type};    my $type = $self->{locator}->{type};
200    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
201    
202    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
203        
204    # propagate args to handler    # try to load perl module at runtime
205    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    my $evalstr = "use $pkg;";
206    if ($type eq 'DBI') {    eval($evalstr);
207      #my @args = %{$self->{locator}->{dbi}};    if ($@) {
208      my @args = %{$self->{locator}};      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
209      $self->{STORAGEHANDLE} = $pkg->new( @args );      return;
   }  
   if ($type eq 'Tangram') {  
     #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );  
     #my @args = %{$self->{locator}->{dbi}};  
     my @args = %{$self->{locator}};  
     $self->{STORAGEHANDLE} = $pkg->new( @args );  
     #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();  
     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();  
210    }    }
211        
212      # build up some additional arguments to pass on
213      #my @args = %{$self->{locator}};
214      my @args = ();
215    
216      # create new storage handle object, propagate arguments to handler
217      # pass locator by reference to be able to store status information in it
218      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
219    
220  }  }
221    
222  sub addLogDispatchHandler {  sub addLogDispatchHandler {
# Line 116  sub addLogDispatchHandler { Line 224  sub addLogDispatchHandler {
224        my $self = shift;        my $self = shift;
225        my $name = shift;        my $name = shift;
226        my $package = shift;        my $package = shift;
227        my $logger = shift;        my $logger1 = shift;
228        my $objectCreator = shift;        my $objectCreator = shift;
229                
230        #$logger->add( Log::Dispatch::Tangram->new( name => $name,        #$logger->add( Log::Dispatch::Tangram->new( name => $name,
# Line 143  sub removeLogDispatchHandler { Line 251  sub removeLogDispatchHandler {
251    
252        my $self = shift;        my $self = shift;
253        my $name = shift;        my $name = shift;
254        my $logger = shift;        #my $logger = shift;
255    
256        $logger->remove($name);        $logger->remove($name);
257    
# Line 167  sub testDsn { Line 275  sub testDsn {
275      $dbh->disconnect();      $dbh->disconnect();
276      return 1;      return 1;
277    } else {    } else {
278      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . DBI::errstr );      $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
279    }    }
280  }  }
281    
 1;  
282    sub testAvailability {
283      my $self = shift;
284      my $status = $self->testDsn();
285      $self->{locator}->{status}->{available} = $status;
286      return $status;
287    }
288    
289    sub createDb {
290      my $self = shift;
291      my $dsn = $self->{locator}->{dbi}->{dsn};
292    
293      $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );
294    
295      $dsn =~ s/database=(.+?);//;
296      my $database_name = $1;
297    
298      my $ok;
299      
300      if ( my $dbh = DBI->connect($dsn, '', '', {
301                                                          PrintError => 0,
302                                                          } ) ) {
303        if ($database_name) {
304          if ($dbh->do("CREATE DATABASE $database_name;")) {
305            $ok = 1;
306          }
307        }
308        $dbh->disconnect();
309      }
310      
311      return $ok;
312      
313    }
314    
315    sub dropDb {
316      my $self = shift;
317      my $dsn = $self->{locator}->{dbi}->{dsn};
318    
319      $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );
320    
321      $dsn =~ s/database=(.+?);//;
322      my $database_name = $1;
323    
324      my $ok;
325      
326      if ( my $dbh = DBI->connect($dsn, '', '', {
327                                                          PrintError => 0,
328                                                          } ) ) {
329        if ($database_name) {
330          if ($dbh->do("DROP DATABASE $database_name;")) {
331            $ok = 1;
332          }
333        }
334        $dbh->disconnect();
335      }
336      
337      return $ok;
338    }
339    
340    sub isConnected {
341      my $self = shift;
342      return 1 if $self->{STORAGEHANDLE};
343    }
344    
345    1;
346    __END__
347    
348    
349    =head1 DESCRIPTION
350    
351    Data::Storage is module for a accessing various "data structures" stored inside
352    various "data containers". It sits on top of DBI and/or Tangram.
353    
354    
355    =head1 AUTHORS / COPYRIGHT
356    
357    The Data::Storage module is Copyright (c) 2002 Andreas Motl.
358    All rights reserved.
359    
360    You may distribute it under the terms of either the GNU General Public
361    License or the Artistic License, as specified in the Perl README file.
362    
363    
364    =head1 ACKNOWLEDGEMENTS
365    
366    Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,
367    Sam Vilain for Class::Tangram, Adam Spiers for MySQL::Diff and all contributors.
368    
369    
370    =head1 SUPPORT / WARRANTY
371    
372    Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.
373    
374    
375    =head1 TODO
376    
377    
378    =head2 Handle the following errors/cases:
379    
380    =head3 "DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"
381    
382        ... occours when operating on object-attributes not introduced yet:
383        this should be detected and appended/replaced through:
384        "Schema-Error detected, maybe (just) an inconsistency.
385        Please check if your declaration in schema-module "a" matches structure in database "b" or try to run"
386        db_setup.pl --dbkey=import --action=deploy
387    
388    =head3 Compare schema (structure diff) with database ...
389    
390      ... when issuing "db_setup.pl --dbkey=import --action=deploy"
391      on a database with an already deployed schema, use an additional "--update" then
392      to lift the schema inside the database to the current declared schema.
393      You will have to approve removals and changes on field-level while
394      new objects and new fields are introduced silently without any interaction needed.
395      In future versions there may be additional options to control silent processing of
396      removals and changes.
397      See this CRUD-table applying to the actions occouring on Classes and Class variables when deploying schemas,
398      don't mix this up with CRUD-actions on Objects, these are already handled by (e.g.) Tangram itself.
399      Classes:
400        C create    ->  yes, handled automatically
401        R retrieve  ->  no, not subject of this aspect since it is about deployment only
402        U update    ->  yes, automatically for Class meta-attributes, yes/no for Class variables (look at the rules down here)
403        D delete    ->  yes, just by user-interaction
404      Class variables:
405        C create    ->  yes, handled automatically
406        R retrieve  ->  no, not subject of this aspect since it is about deployment only
407        U update    ->  yes, just by user-interaction; maybe automatically if it can be determined that data wouldn't be lost
408        D delete    ->  yes, just by user-interaction
409      
410      It's all about not to be able to loose data simply while this is in pre-alpha stage.
411      And loosing data by being able to modify and redeploy schemas easily is definitely quite easy.
412      
413      As we can see, creations of Classes and new Class variables is handled
414      automatically and this is believed to be the most common case under normal circumstances.
415    
416    
417    =head2 Introduce some features:
418    
419      - Get this stuff together with UML (Unified Modeling Language) and/or standards from ODMG.
420      - Make it possible to load/save schemas in XMI (XML Metadata Interchange),
421        which seems to be most commonly used today, perhaps handle objects with OIFML.
422        Integrate/bundle this with a web-/html-based UML modeling tool or
423        some other interesting stuff like the "Co-operative UML Editor" from Uni Darmstadt. (web-/java-based)
424      - Enable Round Trip Engineering. Keep code and diagrams in sync. Don't annoy/bother the programmers.
425      - Add some more handlers:
426        - look at DBD::CSV, Text::CSV, XML::CSV, XML::Excel
427      - Add some more locations/locators:
428        - PerlDAV: http://www.webdav.org/perldav/
429      - Move to t3, use InCASE
430    
431    
432    =head3 Links:
433    
434      Specs:
435        UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf
436        XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf
437        XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf
438        ODMG: http://odmg.org/
439        OIFML: http://odmg.org/library/readingroom/oifml.pdf
440    
441      CASE Tools:
442        Rational Rose (commercial): http://www.rational.com/products/rose/
443        Together (commercial): http://www.oi.com/products/controlcenter/index.jsp
444        InCASE - Tangram-based Universal Object Editor
445        Sybase PowerDesigner: http://www.sybase.com/powerdesigner
446      
447      UML Editors:
448        Fujaba (free, university): http://www.fujaba.de/
449        ArgoUML (free): http://argouml.tigris.org/
450        Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3
451        Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html
452        Metamill (commercial): http://www.metamill.com/
453        Violet (university, research, education): http://www.horstmann.com/violet/
454        PyUt (free): http://pyut.sourceforge.net/
455        (Dia (free): http://www.lysator.liu.se/~alla/dia/)
456        UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html
457        Voodoo (free): http://voodoo.sourceforge.net/
458        Umbrello UML Modeller: http://uml.sourceforge.net/
459    
460      UML Tools:
461        http://www.objectsbydesign.com/tools/umltools_byPrice.html
462    
463      Further readings:
464        http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N
465        http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf
466        http://www.enhyper.com/src/documentation/
467        http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf
468        http://citeseer.nj.nec.com/vilain00diagrammatic.html
469        http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp
470    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed