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

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

Parent Directory | Revision Log | View Patch Patch

-revision 1.2 by joko,
Thu Oct 17 00:04:29 2002 UTC
+revision 1.14 by joko,
Thu Dec 19 16:27:59 2002 UTC
 Line 1
- #################################
+ # $Id$
  #
- #  $Id$
+ # Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
+ #
+ # See COPYRIGHT section in pod text below for usage and distribution rights.
+ #
+ ############################################
  #
  #  $Log$
+ #  Revision 1.14  2002/12/19 16:27:59  joko
+ #  - moved 'sub dropDb' to Data::Storage::Handler::DBI
+ #
+ #  Revision 1.13  2002/12/17 21:54:12  joko
+ #  + 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)
+ #        + enhanced Data::Storage::Handler::Tangram 'sub getObjectByGuid' (jonen)
+ #    + how?
+ #        + 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
-Line 11
+Line 64
  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
  #  + new
  #
- #
+ ############################################
- #################################
+ BEGIN {
+   $Data::Storage::VERSION = 0.02;
+ }
+ =head1 NAME
+   Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way
+ =head1 AIMS
+   - should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary (more convenient) way ;)
+   - 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
+   - provide generic synchronization mechanisms across arbitrary/multiple storages based on ident/checksum
+     maybe it's possible to have schema-, structural- and semantical modifications synchronized???
+ =head1 SYNOPSIS
+ =head2 BASIC ACCESS
+ =head2 ADVANCED ACCESS
+   ... 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 SYNCHRONIZATION
+   my $nodemapping = {
+     'LangText' => 'langtexts.csv',
+     'Currency' => 'currencies.csv',
+     'Country'  => 'countries.csv',
+   };
+   my $propmapping = {
+     'LangText' => [
+       [ 'source:lcountrykey'  =>  'target:country' ],
+       [ 'source:lkey'         =>  'target:key' ],
+       [ 'source:lvalue'       =>  'target:text' ],
+     ],
+     'Currency' => [
+       [ 'source:ckey'         =>  'target:key' ],
+       [ 'source:cname'        =>  'target:text' ],
+     ],
+     'Country' => [
+       [ 'source:ckey'         =>  'target:key' ],
+       [ 'source:cname'        =>  'target:text' ],
+     ],
+   };
+   sub syncResource {
+     my $self = shift;
+     my $node_source = shift;
+     my $mode = shift;
+     my $opts = shift;
+     $mode ||= '';
+     $opts->{erase} ||= 0;
+     $logger->info( __PACKAGE__ . "->syncResource( node_source $node_source mode $mode erase $opts->{erase} )");
+     # resolve metadata for syncing requested resource
+     my $node_target = $nodemapping->{$node_source};
+     my $mapping = $propmapping->{$node_source};
+     if (!$node_target || !$mapping) {
+       # loggger.... "no target, sorry!"
+       print "error while resolving resource metadata", "\n";
+       return;
+     }
+     if ($opts->{erase}) {
+       $self->_erase_all($node_source);
+     }
+     # create new sync object
+     my $sync = Data::Transfer::Sync->new(
+       storages => {
+         L => $self->{bizWorks}->{backend},
+         R => $self->{bizWorks}->{resources},
+       },
+       id_authorities        =>  [qw( L ) ],
+       checksum_authorities  =>  [qw( L ) ],
+       write_protected       =>  [qw( R ) ],
+       verbose               =>  1,
+     );
+     # sync
+     # todo: filter!?
+     $sync->syncNodes( {
+       direction       =>  $mode,                 # | +PUSH | +PULL | -FULL | +IMPORT | -EXPORT
+       method          =>  'checksum',            # | -timestamp | -manual
+       source          =>  "L:$node_source",
+       source_ident    =>  'storage_method:id',
+       source_exclude  =>  [qw( id cs )],
+       target          =>  "R:$node_target",
+       target_ident    =>  'property:oid',
+       mapping         =>  $mapping,
+     } );
+   }
+ =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
+     DBD::mysql       from CPAN
+     Tangram 2.04     from CPAN         (hmmm, 2.04 won't do in some cases)
+     Tangram 2.05     from http://...   (2.05 seems okay but there are also additional patches from our side)
+     Class::Tangram   from CPAN
+     DBD::CSV         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;
-Line 20 
 use strict;
+Line 215 
 use strict;
  use warnings;
  use Data::Storage::Locator;
+ use Data::Dumper;
+ # TODO: wipe out!
+ use DBI;
+ # TODO: actually implement level (integrate with Log::Dispatch)
+ my $TRACELEVEL = 0;
  # get logger instance
  my $logger = Log::Dispatch::Config->instance;
-Line 28 
 sub new {
+Line 230 
 sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    #my @args = normalizeArgs(@_);
    my $arg_locator = shift;
    my $arg_options = shift;
    #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 45 
 sub AUTOLOAD {
+Line 248 
 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 56 
 sub AUTOLOAD {
+Line 259 
 sub AUTOLOAD {
    my $method = $AUTOLOAD;
    $method =~ s/^.*:://;
-   # advanced logging of AUTOLOAD calls
+   # advanced logging of AUTOLOAD calls ...
-     my $logstring = __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)";
+   # ... nice but do it only when TRACING (TODO) is enabled
-     my $tabcount = int( (80 - length($logstring)) / 10 );
+     if ($TRACELEVEL) {
-     $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
+       my $logstring = "";
-     # TODO: only ok if logstring doesn't contain
+       $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
-     #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
+       #print "count: ", $#_, "\n";
-     # but that would be way too specific as long as we don't have an abstract handler for this  ;)
+       #$logstring .= Dumper(@_) if ($#_ != -1);
-     $logger->debug( $logstring );
+       my $tabcount = int( (80 - length($logstring)) / 10 );
+       $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
-   # filtering AUTOLOAD calls
+       # 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  ;)
+       $logger->debug( $logstring );
+       #print join('; ', @_);
+     }
+   # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
    if ($self->_filter_AUTOLOAD($method)) {
+     #print "_accessStorage\n";
      $self->_accessStorage();
      $self->{STORAGEHANDLE}->$method(@_);
    }
-Line 97 
 sub normalizeArgs {
+Line 308 
 sub normalizeArgs {
  sub _accessStorage {
    my $self = shift;
    # TODO: to some tracelevel!
-   #$logger->debug( __PACKAGE__ .  "[$self->{type}]" . "->_accessStorage()" );
+   if ($TRACELEVEL) {
+     $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
+   }
    if (!$self->{STORAGEHANDLE}) {
      $self->_createStorageHandle();
    }
-Line 105 
 sub _accessStorage {
+Line 318 
 sub _accessStorage {
  sub _createStorageHandle {
    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;
-     $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}};
-     $self->{STORAGEHANDLE} = $pkg->new( @args );
-     #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage();
-     #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE();
    }
+   # 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 );
  }
  sub addLogDispatchHandler {
-Line 136 
 sub addLogDispatchHandler {
+Line 347 
 sub addLogDispatchHandler {
        my $self = shift;
        my $name = shift;
        my $package = shift;
-       my $logger = shift;
+       my $logger1 = shift;
        my $objectCreator = shift;
        #$logger->add( Log::Dispatch::Tangram->new( name => $name,
-Line 160 
 sub addLogDispatchHandler {
+Line 371 
 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);
  }
  sub getDbName {
-Line 177 
 sub getDbName {
+Line 385 
 sub getDbName {
    return $database_name;
  }
+ sub testAvailability {
+   my $self = shift;
+   my $status = $self->testDsn();
+   $self->{locator}->{status}->{available} = $status;
+   return $status;
+ }
+ sub isConnected {
+   my $self = shift;
+   # TODO: REVIEW!
+   return 1 if $self->{STORAGEHANDLE};
+ }
  sub testDsn {
    my $self = shift;
    my $dsn = $self->{locator}->{dbi}->{dsn};
-Line 184 
 sub testDsn {
+Line 405 
 sub testDsn {
    if ( my $dbh = DBI->connect($dsn, '', '', {
                                                        PrintError => 0,
                                                        } ) ) {
+     # TODO: REVIEW
      $dbh->disconnect();
      return 1;
    } else {
-     $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
+     $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
    }
  }
- sub createDb {
+;
-   my $self = shift;
+ __END__
-   my $dsn = $self->{locator}->{dbi}->{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 isConnected {
+ =head1 DESCRIPTION
-   my $self = shift;
-   return 1 if $self->{STORAGEHANDLE};
+ =head2 Data::Storage
- }
+   Data::Storage is a module for accessing various "data structures / kinds of structured data" stored inside
+   various "data containers".
+   We tried to use the AdapterPattern (http://c2.com/cgi/wiki?AdapterPattern) to implement a wrapper-layer
+   around core CPAN modules (Tangram, DBI).
+ =head2 Why?
+   You will get a better code-structure (not bad for later maintenance) in growing Perl code projects,
+   especially when using multiple database connections at the same time.
+   You will be able to switch between different _kinds_ of implementations used for storing data.
+   Your code will use the very same API to access these storage layers.
+       ... implementation has to be changed for now
+   Maybe you will be able to switch "on-the-fly" without changing any bits in code in the future....
+       ... but that's not the focus
+ =head2 What else?
+   Having this, we were able to do implement a generic data synchronization module more easy,
+   please look at Data::Transfer.
+ =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, Jochen Wiedmann and Jeff Zucker for DBD::CSV & Co.,
+   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 BUGS
+ "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
+ 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 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 support for some more handlers/locators to be able to
+      access the following standards/protocols/interfaces/programs/apis transparently:
+     +  DBD::CSV (via Data::Storage::Handler::DBI)
+    (-) Text::CSV, XML::CSV, XML::Excel
+     -  MAPI
+     -  LDAP
+     -  DAV (look at PerlDAV: http://www.webdav.org/perldav/)
+     -  Mbox (use formail for seperating/splitting entries/nodes)
+     -  Cyrus (cyrdeliver - what about cyrretrieve (export)???)
+     -  use File::DiffTree, use File::Compare
+     -  Hibernate
+     -  "Win32::UserAccountDb"
+     -  "*nix::UserAccountDb"
+     -  .wab - files (Windows Address Book)
+     -  .pst - files (Outlook Post Storage?)
+     -  XML (e.g. via XML::Simple?)
+   - Move to t3, look at InCASE
+   - some kind of security layer for methods/objects
+     - acls (stored via tangram/ldap?) for functions, methods and objects (entity- & data!?)
+     - where are the hooks needed then?
+       - is Data::Storage & Co. okay, or do we have to touch the innards of DBI and/or Tangram?
+       - an attempt to start could be:
+          - 'sub getACLByObjectId($id, $context)'
+          - 'sub getACLByMethodname($id, $context)'
+          - 'sub getACLByName($id, $context)'
+             ( would require a kinda registry to look up these very names pointing to arbitrary locations (code, data, ...) )
+   - add more hooks and various levels
+   - better integrate introduced 'getObjectByGuid'-mechanism from Data::Storage::Handler::Tangram
+ =head3 LINKS / REFERENCES
+   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.2
 


changed lines


 
Added in v.1.14
 Legend:



Removed from v.1.2
 


changed lines


 
Added in v.1.14
-Removed from v.1.2
+Added in v.1.14

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26