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

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

Parent Directory | Revision Log | View Patch Patch

-revision 1.7 by joko,
Sun Nov 17 06:07:18 2002 UTC
+revision 1.20 by joko,
Wed Jun 25 22:51:51 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.7  2002/11/17 06:07:18  joko
+ ##
- #  + creating the handler is easier than proposed first - for now :-)
+ ##  $Log$
- #  + sub testAvailability
+ ##  Revision 1.20  2003/06/25 22:51:51  joko
- #
+ ##  + sub get_locator_type & Co.
- #  Revision 1.6  2002/11/09 01:04:58  joko
+ ##
- #  + updated pod
+ ##  Revision 1.19  2003/02/18 19:22:11  joko
- #
+ ##  + fixed logging
- #  Revision 1.5  2002/10/29 19:24:18  joko
+ ##
- #  - reduced logging
+ ##  Revision 1.18  2003/01/30 22:12:17  joko
- #  + added some pod
+ ##  - removed/refactored old code: ->Data::Storage::Handler::Tangram|DBI
- #
+ ##
- #  Revision 1.4  2002/10/27 18:35:07  joko
+ ##  Revision 1.17  2003/01/30 21:42:22  joko
- #  + added pod
+ ##  + minor update: renamed method
- #
+ ##
- #  Revision 1.3  2002/10/25 11:40:37  joko
+ ##  Revision 1.16  2003/01/20 16:52:13  joko
- #  + enhanced robustness
+ ##  + now using 'DesignPattern::Object' to create a new 'Data::Storage::Handler::Xyz' on demand - before we did this in a hand-rolled fashion
- #  + more logging for debug-levels
+ ##
- #  + sub dropDb
+ ##  Revision 1.15  2003/01/19 03:12:59  joko
- #
+ ##  + modified header
- #  Revision 1.2  2002/10/17 00:04:29  joko
+ ##  - removed pod-documentation - now in 'Storage.pod'
- #  + sub createDb
+ ##
- #  + sub isConnected
+ ##  Revision 1.14  2002/12/19 16:27:59  joko
- #  + bugfixes regarding "deep recursion" stuff
+ ##  - moved 'sub dropDb' to Data::Storage::Handler::DBI
- #
+ ##
- #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
+ ##  Revision 1.13  2002/12/17 21:54:12  joko
- #  + new
+ ##  + feature when using Tangram:
- #
+ ##    + what? each object created should delivered with a globally(!?) unique identifier (GUID) besides the native tangram object id (OID)
- #################################
+ ##        + patched Tangram::Storage (jonen)
+ ##        + enhanced Data::Storage::Schema::Tangram (joko)
- # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
+ ##        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
- # aim_V2: introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
+ ##    + how?
- #               - Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
+ ##        + each concrete (non-abstract) class gets injected with an additional field/property called 'guid' - this is done (dynamically) on schema level
+ ##        + this property ('guid') gets filled on object creation/insertion from 'sub Tangram::Storage::_insert' using Data::UUID from CPAN
+ ##        + (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
+ ##  + TODO: these have to be refactored to another scope! (soon!)
+ ##
+ ##  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::Storage::Locator;
  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 111 
 sub new {
+Line 117 
 sub new {
    my $arg_locator = shift;
    my $arg_options = shift;
+   #my @args = @_;
+   #@args ||= ();
+   if (!$arg_locator) {
+     $logger->critical( __PACKAGE__ . "->new: No locator passed in!" );
+     return;
+   }
+   #print Dumper($arg_locator);
    #my $self = { STORAGEHANDLE => undef, @_ };
    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
-   $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
+   $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new()" );
    return bless $self, $class;
  }
-Line 126 
 sub AUTOLOAD {
+Line 141 
 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 137 
 sub AUTOLOAD {
+Line 152 
 sub AUTOLOAD {
    my $method = $AUTOLOAD;
    $method =~ s/^.*:://;
+   #print __PACKAGE__, "\n";
+   #print $method, "\n";
+   #print $self->{locator}, "\n";
+   my $locator_type = $self->get_locator_type();
    # 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;
+       $logstring .= __PACKAGE__ . "[$locator_type]" . "->" . $method;
        #print "count: ", $#_, "\n";
        #$logstring .= Dumper(@_) if ($#_ != -1);
        my $tabcount = int( (80 - length($logstring)) / 10 );
        $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)) {
-     #print "_accessStorage\n";
+     #print "=== FILTER!", "\n";
-     $self->_accessStorage();
+     $self->_accessStorageHandle();
-     $self->{STORAGEHANDLE}->$method(@_);
+     if ($self->{STORAGEHANDLE}) {
+       return $self->{STORAGEHANDLE}->$method(@_);
+     } else {
+       my $msg = __PACKAGE__ . "->AUTOLOAD: ERROR: " . $logstring;
+       $logger->critical( $msg ) if $logger;
+       print STDERR $msg if not $logger;
+       return;
+     }
    }
  }
-Line 174 
 sub _filter_AUTOLOAD {
+Line 202 
 sub _filter_AUTOLOAD {
  }
- sub normalizeArgs {
+ sub _accessStorageHandle {
-   my %args = @_;
-   if (!$args{dsn} && $args{meta}{dsn}) {
-     $args{dsn} = $args{meta}{dsn};
-   }
-   my @result = %args;
-   return @result;
- }
- sub _accessStorage {
    my $self = shift;
    # TODO: to some tracelevel!
+   #print "=========== _accessStorage", "\n";
    if ($TRACELEVEL) {
-     $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
+     $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorageHandle()" );
    }
    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()" );
-Line 213 
 sub _createStorageHandle {
+Line 233 
 sub _createStorageHandle {
    #my @args = %{$self->{locator}};
    my @args = ();
-   # create new storage handle object, propagate arguments to handler
+   # - create new storage handle object
-   # pass locator by reference to be able to store status information in it
+   # - 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;
+   # 2003-06-18: protection against storagehandles w/o locators
+   return if not defined $self->{locator};
+   my $type = $self->get_locator_type();
+   $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
+ #print Dumper($self);
+ #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;
  }
-Line 248 
 sub addLogDispatchHandler {
+Line 307 
 sub addLogDispatchHandler {
  }
  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->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
-   }
- }
- sub testAvailability {
-   my $self = shift;
-   my $status = $self->testDsn();
-   $self->{locator}->{status}->{available} = $status;
-   return $status;
- }
- 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 {
    my $self = shift;
-   my $dsn = $self->{locator}->{dbi}->{dsn};
+   my $name = shift;
+   #my $logger = shift;
-   $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;
  }
- sub isConnected {
+ sub get_locator_type {
    my $self = shift;
-   return 1 if $self->{STORAGEHANDLE};
+   my $locator_type = '';
+   $locator_type = $self->{locator}->{type} if defined $self->{locator};
+   return $locator_type;
  }
 ;
  __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.20
 Legend:



Removed from v.1.7
 


changed lines


 
Added in v.1.20
-Removed from v.1.7
+Added in v.1.20

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26