/[cvs]/nfo/perl/libs/Data/Storage.pm

Diff of /nfo/perl/libs/Data/Storage.pm

Parent Directory | Revision Log | View Patch Patch

-revision 1.6 by joko,
Sat Nov  9 01:04:58 2002 UTC
+revision 1.16 by joko,
Mon Jan 20 16:52:13 2003 UTC
 Line 1
- # $Id$
+ ## ------------------------------------------------------------------------
- #
+ ##
- # Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
+ ##    $Id$
- #
+ ##
- # See COPYRIGHT section in pod text below for usage and distribution rights.
+ ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
- #
+ ##
- #################################
+ ##    See COPYRIGHT section in pod text below for usage and distribution rights.
- #
+ ##
- #  $Log$
+ ## ------------------------------------------------------------------------
- #  Revision 1.6  2002/11/09 01:04:58  joko
+ ##
- #  + updated pod
+ ##  $Log$
- #
+ ##  Revision 1.16  2003/01/20 16:52:13  joko
- #  Revision 1.5  2002/10/29 19:24:18  joko
+ ##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
- #  - reduced logging
+ ##
- #  + added some pod
+ ##  Revision 1.15  2003/01/19 03:12:59  joko
- #
+ ##  + modified header
- #  Revision 1.4  2002/10/27 18:35:07  joko
+ ##  - removed pod-documentation - now in 'Storage.pod'
- #  + added pod
+ ##
- #
+ ##  Revision 1.14  2002/12/19 16:27:59  joko
- #  Revision 1.3  2002/10/25 11:40:37  joko
+ ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
- #  + enhanced robustness
+ ##
- #  + more logging for debug-levels
+ ##  Revision 1.13  2002/12/17 21:54:12  joko
- #  + sub dropDb
+ ##  + feature when using Tangram:
- #
+ ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
- #  Revision 1.2  2002/10/17 00:04:29  joko
+ ##        + patched Tangram::Storage (jonen)
- #  + sub createDb
+ ##        + enhanced Data::Storage::Schema::Tangram (joko)
- #  + sub isConnected
+ ##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
- #  + bugfixes regarding "deep recursion" stuff
+ ##    + how?
- #
+ ##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
- #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
+ ##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
- #  + new
+ ##        + (as for now) this property can get accessed by calling 'getObjectByGuid' on the already known storage-handle used throughout the application
- #
+ ##
- #################################
+ ##  Revision 1.12  2002/12/12 02:50:15  joko
+ ##  + this now (unfortunately) needs DBI for some helper functions
- # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
+ ##  + TODO: these have to be refactored to another scope! (soon!)
- # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
+ ##
- #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
+ ##  Revision 1.11  2002/12/11 06:53:19  joko
+ ##  + updated pod
+ ##
+ ##  Revision 1.10  2002/12/07 03:37:23  joko
+ ##  + updated pod
+ ##
+ ##  Revision 1.9  2002/12/01 22:15:45  joko
+ ##  - sub createDb: moved to handler
+ ##
+ ##  Revision 1.8  2002/11/29 04:48:23  joko
+ ##  + updated pod
+ ##
+ ##  Revision 1.7  2002/11/17 06:07:18  joko
+ ##  + creating the handler is easier than proposed first - for now :-)
+ ##  + sub testAvailability
+ ##
+ ##  Revision 1.6  2002/11/09 01:04:58  joko
+ ##  + updated pod
+ ##
+ ##  Revision 1.5  2002/10/29 19:24:18  joko
+ ##  - reduced logging
+ ##  + added some pod
+ ##
+ ##  Revision 1.4  2002/10/27 18:35:07  joko
+ ##  + added pod
+ ##
+ ##  Revision 1.3  2002/10/25 11:40:37  joko
+ ##  + enhanced robustness
+ ##  + more logging for debug-levels
+ ##  + sub dropDb
+ ##
+ ##  Revision 1.2  2002/10/17 00:04:29  joko
+ ##  + sub createDb
+ ##  + sub isConnected
+ ##  + bugfixes regarding "deep recursion" stuff
+ ##
+ ##  Revision 1.1  2002/10/10 03:43:12  cvsjoko
+ ##  + new
+ ## ------------------------------------------------------------------------
  BEGIN {
- $Data::Storage::VERSION = 0.01;
+   $Data::Storage::VERSION = 0.03;
  }
- =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.
  package Data::Storage;
  use strict;
  use warnings;
+ use Data::Dumper;
+ # FIXME: wipe out!
+ use DBI;
  use Data::Storage::Locator;
+ use DesignPattern::Object;
  # TODO: actually implement level (integrate with Log::Dispatch)
  my $TRACELEVEL = 0;
-Line 103 
 sub new {
+Line 102 
 sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    #my @args = normalizeArgs(@_);
    my $arg_locator = shift;
    my $arg_options = shift;
+   if (!$arg_locator) {
+     $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
+     return;
+   }
    #my $self = { STORAGEHANDLE => undef, @_ };
    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
-   $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
+   #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
+   $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
    return bless $self, $class;
  }
-Line 120 
 sub AUTOLOAD {
+Line 125 
 sub AUTOLOAD {
    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
    #     - Deep recursion on anonymous subroutine at [...]
-   # 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"
    my $self = shift;
    our $AUTOLOAD;
-Line 133 
 sub AUTOLOAD {
+Line 138 
 sub AUTOLOAD {
    # advanced logging of AUTOLOAD calls ...
    # ... nice but do it only when TRACING (TODO) is enabled
-     if ($TRACELEVEL) {
        my $logstring = "";
        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
        #print "count: ", $#_, "\n";
-Line 142 
 sub AUTOLOAD {
+Line 146 
 sub AUTOLOAD {
        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
        # TODO: only ok if logstring doesn't contain
        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
-       # 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  ;)
+     if ($TRACELEVEL) {
        $logger->debug( $logstring );
+       #print join('; ', @_);
      }
-   # filtering AUTOLOAD calls
+   # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
    if ($self->_filter_AUTOLOAD($method)) {
      $self->_accessStorage();
-     $self->{STORAGEHANDLE}->$method(@_);
+     if ($self->{STORAGEHANDLE}) {
+       return $self->{STORAGEHANDLE}->$method(@_);
+     } else {
+       $logger->critical( __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring );
+       return;
+     }
    }
  }
-Line 182 
 sub _accessStorage {
+Line 193 
 sub _accessStorage {
      $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
    }
    if (!$self->{STORAGEHANDLE}) {
-     $self->_createStorageHandle();
+     return $self->_createStorageHandle();
    }
  }
- sub _createStorageHandle {
+ sub _createStorageHandle1 {
    my $self = shift;
    my $type = $self->{locator}->{type};
    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
    my $pkg = "Data::Storage::Handler::" . $type . "";
-   # propagate args to handler
+   # try to load perl module at runtime
-   # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)
+   my $evalstr = "use $pkg;";
-   if ($type eq 'DBI') {
+   eval($evalstr);
-     use Data::Storage::Handler::DBI;
+   if ($@) {
-     #my @args = %{$self->{locator}->{dbi}};
+     $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
-     my @args = %{$self->{locator}};
+     return;
-     # create new storage handle
-     $self->{STORAGEHANDLE} = $pkg->new( @args );
    }
-   if ($type eq 'Tangram') {
-     use Data::Storage::Handler::Tangram;
+   # build up some additional arguments to pass on
-     #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} );
+   #my @args = %{$self->{locator}};
-     #my @args = %{$self->{locator}->{dbi}};
+   my @args = ();
-     my @args = %{$self->{locator}};
-     # create new storage handle
+   # - create new storage handle object
-     $self->{STORAGEHANDLE} = $pkg->new( @args );
+   # - propagate arguments to handler
+   # - pass locator by reference to be able to store status- or meta-information in it
+   $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
+ }
+ sub _createStorageHandle {
+   my $self = shift;
+   my $type = $self->{locator}->{type};
+   $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
-     #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();
+ #print Dumper($self);
-     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
+ #exit;
+   my $pkg = "Data::Storage::Handler::" . $type . "";
+   # try to load perl module at runtime
+ =pod
+   my $evalstr = "use $pkg;";
+   eval($evalstr);
+   if ($@) {
+     $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
+     return;
    }
+   # build up some additional arguments to pass on
+   #my @args = %{$self->{locator}};
+   my @args = ();
+   # - create new storage handle object
+   # - propagate arguments to handler
+   # - pass locator by reference to be able to store status- or meta-information in it
+   $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
+ =cut
+   $self->{STORAGEHANDLE} = DesignPattern::Object->fromPackage( $pkg, locator => $self->{locator} );
+   return 1;
  }
  sub addLogDispatchHandler {
-Line 246 
 sub addLogDispatchHandler {
+Line 286 
 sub addLogDispatchHandler {
  }
  sub removeLogDispatchHandler {
+   my $self = shift;
-       my $self = shift;
+   my $name = shift;
-       my $name = shift;
+   #my $logger = shift;
-       #my $logger = shift;
+   $logger->remove($name);
-       $logger->remove($name);
  }
+ =pod
  sub getDbName {
    my $self = shift;
    my $dsn = $self->{locator}->{dbi}->{dsn};
-Line 263 
 sub getDbName {
+Line 301 
 sub getDbName {
    return $database_name;
  }
- sub testDsn {
+ sub testAvailability {
    my $self = shift;
-   my $dsn = $self->{locator}->{dbi}->{dsn};
+   my $status = $self->testDsn();
-   my $result;
+   $self->{locator}->{status}->{available} = $status;
-   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 );
-   }
  }
- sub createDb {
+ sub isConnected {
    my $self = shift;
-   my $dsn = $self->{locator}->{dbi}->{dsn};
+   # TODO: REVIEW!
+   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;
  }
- sub dropDb {
+ sub testDsn {
    my $self = shift;
    my $dsn = $self->{locator}->{dbi}->{dsn};
+   my $result;
-   $logger->debug( __PACKAGE__ .  "->dropDb( 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("DROP DATABASE $database_name;")) {
+     # TODO: REVIEW
-         $ok = 1;
-       }
-     }
      $dbh->disconnect();
+     return 1;
+   } else {
+     $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
    }
-   return $ok;
- }
- sub isConnected {
-   my $self = shift;
-   return 1 if $self->{STORAGEHANDLE};
  }
+ =cut
 ;
  __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.6
 


changed lines


 
Added in v.1.16
 Legend:



Removed from v.1.6
 


changed lines


 
Added in v.1.16
-Removed from v.1.6
+Added in v.1.16

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26