/[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.3 by joko, Fri Oct 25 11:40:37 2002 UTC revision 1.9 by joko, Sun Dec 1 22:15:45 2002 UTC
# Line 1  Line 1 
1  #################################  # $Id$
2  #  #
3  #  $Id$  # Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
4    #
5    # See COPYRIGHT section in pod text below for usage and distribution rights.
6    #
7    ############################################
8  #  #
9  #  $Log$  #  $Log$
10    #  Revision 1.9  2002/12/01 22:15:45  joko
11    #  - sub createDb: moved to handler
12    #
13    #  Revision 1.8  2002/11/29 04:48:23  joko
14    #  + updated pod
15    #
16    #  Revision 1.7  2002/11/17 06:07:18  joko
17    #  + creating the handler is easier than proposed first - for now :-)
18    #  + sub testAvailability
19    #
20    #  Revision 1.6  2002/11/09 01:04:58  joko
21    #  + updated pod
22    #
23    #  Revision 1.5  2002/10/29 19:24:18  joko
24    #  - reduced logging
25    #  + added some pod
26    #
27    #  Revision 1.4  2002/10/27 18:35:07  joko
28    #  + added pod
29    #
30  #  Revision 1.3  2002/10/25 11:40:37  joko  #  Revision 1.3  2002/10/25 11:40:37  joko
31  #  + enhanced robustness  #  + enhanced robustness
32  #  + more logging for debug-levels  #  + more logging for debug-levels
# Line 16  Line 40 
40  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko  #  Revision 1.1  2002/10/10 03:43:12  cvsjoko
41  #  + new  #  + new
42  #  #
43  #  ############################################
44  #################################  
45    
46    BEGIN {
47      $Data::Storage::VERSION = 0.02;
48    }
49    
50    
51    =head1 NAME
52    
53    Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way
54    
55    
56    =head1 AIMS
57    
58      - should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary (more convenient) way ;)
59      - introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
60        Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
61      - provide generic synchronization mechanisms across arbitrary/multiple storages based on ident/checksum
62        maybe it's possible to have schema-, structural- and semantical modifications synchronized???
63    
64    
65    =head1 SYNOPSIS
66    
67    =head2 BASIC ACCESS
68    
69    =head2 ADVANCED ACCESS
70    
71      ... via inheritance:
72      
73        use Data::Storage;
74        my $proxyObj = new HttpProxy;
75        $proxyObj->{url} = $url;
76        $proxyObj->{payload} = $content;
77        $self->{storage}->insert($proxyObj);
78        
79        use Data::Storage;
80        my $proxyObj = HttpProxy->new(
81          url => $url,
82          payload => $content,
83        );
84        $self->{storage}->insert($proxyObj);
85    
86    
87    =head2 SYNCHRONIZATION
88    
89      my $nodemapping = {
90        'LangText' => 'langtexts.csv',
91        'Currency' => 'currencies.csv',
92        'Country'  => 'countries.csv',
93      };
94    
95      my $propmapping = {
96        'LangText' => [
97          [ 'source:lcountrykey'  =>  'target:country' ],
98          [ 'source:lkey'         =>  'target:key' ],
99          [ 'source:lvalue'       =>  'target:text' ],
100        ],
101        'Currency' => [
102          [ 'source:ckey'         =>  'target:key' ],
103          [ 'source:cname'        =>  'target:text' ],
104        ],
105        'Country' => [
106          [ 'source:ckey'         =>  'target:key' ],
107          [ 'source:cname'        =>  'target:text' ],
108        ],
109      };
110    
111      sub syncResource {
112    
113        my $self = shift;
114        my $node_source = shift;
115        my $mode = shift;
116        my $opts = shift;
117        
118        $mode ||= '';
119        $opts->{erase} ||= 0;
120        
121        $logger->info( __PACKAGE__ . "->syncResource( node_source $node_source mode $mode erase $opts->{erase} )");
122      
123        # resolve metadata for syncing requested resource
124        my $node_target = $nodemapping->{$node_source};
125        my $mapping = $propmapping->{$node_source};
126        
127        if (!$node_target || !$mapping) {
128          # loggger.... "no target, sorry!"
129          print "error while resolving resource metadata", "\n";
130          return;
131        }
132        
133        if ($opts->{erase}) {
134          $self->_erase_all($node_source);
135        }
136      
137        # create new sync object
138        my $sync = Data::Transfer::Sync->new(
139          storages => {
140            L => $self->{bizWorks}->{backend},
141            R => $self->{bizWorks}->{resources},
142          },
143          id_authorities        =>  [qw( L ) ],
144          checksum_authorities  =>  [qw( L ) ],
145          write_protected       =>  [qw( R ) ],
146          verbose               =>  1,
147        );
148        
149        # sync
150        # todo: filter!?
151        $sync->syncNodes( {
152          direction       =>  $mode,                 # | +PUSH | +PULL | -FULL | +IMPORT | -EXPORT
153          method          =>  'checksum',            # | -timestamp | -manual
154          source          =>  "L:$node_source",
155          source_ident    =>  'storage_method:id',
156          source_exclude  =>  [qw( id cs )],
157          target          =>  "R:$node_target",
158          target_ident    =>  'property:oid',
159          mapping         =>  $mapping,
160        } );
161    
162      }
163    
164    
165    =head2 NOTE
166    
167    This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks.
168    Please look at their documentation and/or this code for additional information.
169    
170    
171    =head1 REQUIREMENTS
172    
173      For full functionality:
174        DBI              from CPAN
175        DBD::mysql       from CPAN
176        Tangram 2.04     from CPAN         (hmmm, 2.04 won't do in some cases)
177        Tangram 2.05     from http://...   (2.05 seems okay but there are also additional patches from our side)
178        Class::Tangram   from CPAN
179        DBD::CSV         from CPAN
180        MySQL::Diff      from http://adamspiers.org/computing/mysqldiff/
181        ... and all their dependencies
182    
183    =cut
184    
185    # The POD text continues at the end of the file.
186    
 # aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)  
 # 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  
187    
188  package Data::Storage;  package Data::Storage;
189    
# Line 29  use strict; Line 191  use strict;
191  use warnings;  use warnings;
192    
193  use Data::Storage::Locator;  use Data::Storage::Locator;
194    use Data::Dumper;
195    
196    # TODO: actually implement level (integrate with Log::Dispatch)
197    my $TRACELEVEL = 0;
198    
199  # get logger instance  # get logger instance
200  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
# Line 37  sub new { Line 203  sub new {
203    my $invocant = shift;    my $invocant = shift;
204    my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
205    #my @args = normalizeArgs(@_);    #my @args = normalizeArgs(@_);
206      
207    my $arg_locator = shift;    my $arg_locator = shift;
208    my $arg_options = shift;    my $arg_options = shift;
209      
210    #my $self = { STORAGEHANDLE => undef, @_ };    #my $self = { STORAGEHANDLE => undef, @_ };
211    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };    my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
212    $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );    #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
213      $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
214    return bless $self, $class;    return bless $self, $class;
215  }  }
216    
# Line 54  sub AUTOLOAD { Line 221  sub AUTOLOAD {
221    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
222    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"    #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
223    #     - Deep recursion on anonymous subroutine at [...]    #     - Deep recursion on anonymous subroutine at [...]
224    # 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"
225        
226    my $self = shift;    my $self = shift;
227    our $AUTOLOAD;    our $AUTOLOAD;
# Line 65  sub AUTOLOAD { Line 232  sub AUTOLOAD {
232    my $method = $AUTOLOAD;    my $method = $AUTOLOAD;
233    $method =~ s/^.*:://;    $method =~ s/^.*:://;
234    
235    # advanced logging of AUTOLOAD calls    # advanced logging of AUTOLOAD calls ...
236      my $logstring = "";    # ... nice but do it only when TRACING (TODO) is enabled
237      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;      if ($TRACELEVEL) {
238      #print "count: ", $#_, "\n";        my $logstring = "";
239      #$logstring .= Dumper(@_) if ($#_ != -1);        $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
240      my $tabcount = int( (80 - length($logstring)) / 10 );        #print "count: ", $#_, "\n";
241      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";        #$logstring .= Dumper(@_) if ($#_ != -1);
242      # TODO: only ok if logstring doesn't contain        my $tabcount = int( (80 - length($logstring)) / 10 );
243      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"        $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
244      # 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
245      $logger->debug( $logstring );        #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
246          # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
247    # filtering AUTOLOAD calls        $logger->debug( $logstring );
248          #print join('; ', @_);
249        }
250        
251      # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
252    if ($self->_filter_AUTOLOAD($method)) {    if ($self->_filter_AUTOLOAD($method)) {
253        #print "_accessStorage\n";
254      $self->_accessStorage();      $self->_accessStorage();
255      $self->{STORAGEHANDLE}->$method(@_);      $self->{STORAGEHANDLE}->$method(@_);
256    }    }
# Line 109  sub normalizeArgs { Line 281  sub normalizeArgs {
281  sub _accessStorage {  sub _accessStorage {
282    my $self = shift;    my $self = shift;
283    # TODO: to some tracelevel!    # TODO: to some tracelevel!
284    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );    if ($TRACELEVEL) {
285        $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
286      }
287    if (!$self->{STORAGEHANDLE}) {    if (!$self->{STORAGEHANDLE}) {
288      $self->_createStorageHandle();      $self->_createStorageHandle();
289    }    }
# Line 117  sub _accessStorage { Line 291  sub _accessStorage {
291    
292  sub _createStorageHandle {  sub _createStorageHandle {
293    my $self = shift;    my $self = shift;
   
294    my $type = $self->{locator}->{type};    my $type = $self->{locator}->{type};
295    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );    $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );
296    
297    my $pkg = "Data::Storage::Handler::" . $type . "";    my $pkg = "Data::Storage::Handler::" . $type . "";
298        
299    # propagate args to handler    # try to load perl module at runtime
300    # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case)    my $evalstr = "use $pkg;";
301    if ($type eq 'DBI') {    eval($evalstr);
302      use Data::Storage::Handler::DBI;    if ($@) {
303      #my @args = %{$self->{locator}->{dbi}};      $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
304      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();  
305    }    }
306        
307      # build up some additional arguments to pass on
308      #my @args = %{$self->{locator}};
309      my @args = ();
310    
311      # - create new storage handle object
312      # - propagate arguments to handler
313      # - pass locator by reference to be able to store status- or meta-information in it
314      $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
315    
316  }  }
317    
318  sub addLogDispatchHandler {  sub addLogDispatchHandler {
# Line 175  sub addLogDispatchHandler { Line 344  sub addLogDispatchHandler {
344  }  }
345    
346  sub removeLogDispatchHandler {  sub removeLogDispatchHandler {
347      my $self = shift;
348        my $self = shift;    my $name = shift;
349        my $name = shift;    #my $logger = shift;
350        #my $logger = shift;    $logger->remove($name);
   
       $logger->remove($name);  
   
351  }  }
352    
353  sub getDbName {  sub getDbName {
# Line 199  sub testDsn { Line 365  sub testDsn {
365    if ( my $dbh = DBI->connect($dsn, '', '', {    if ( my $dbh = DBI->connect($dsn, '', '', {
366                                                        PrintError => 0,                                                        PrintError => 0,
367                                                        } ) ) {                                                        } ) ) {
368        
369        # TODO: REVIEW
370      $dbh->disconnect();      $dbh->disconnect();
371        
372      return 1;      return 1;
373    } else {    } else {
374      $logger->error( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );      $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
375    }    }
376  }  }
377    
378  sub createDb {  sub testAvailability {
379    my $self = shift;    my $self = shift;
380    my $dsn = $self->{locator}->{dbi}->{dsn};    my $status = $self->testDsn();
381      $self->{locator}->{status}->{available} = $status;
382    $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );    return $status;
   
   $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;  
     
383  }  }
384    
385    
386  sub dropDb {  sub dropDb {
387    my $self = shift;    my $self = shift;
388    my $dsn = $self->{locator}->{dbi}->{dsn};    my $dsn = $self->{locator}->{dbi}->{dsn};
# Line 251  sub dropDb { Line 402  sub dropDb {
402          $ok = 1;          $ok = 1;
403        }        }
404      }      }
405    
406      $dbh->disconnect();      $dbh->disconnect();
407    
408    }    }
409        
410    return $ok;    return $ok;
# Line 262  sub isConnected { Line 415  sub isConnected {
415    return 1 if $self->{STORAGEHANDLE};    return 1 if $self->{STORAGEHANDLE};
416  }  }
417    
 1;  
418    1;
419    __END__
420    
421    
422    =head1 DESCRIPTION
423    
424    Data::Storage is a module for accessing various "data structures" stored inside
425    various "data containers". It sits on top of DBI and/or Tangram.
426    
427    
428    =head1 AUTHORS / COPYRIGHT
429    
430    The Data::Storage module is Copyright (c) 2002 Andreas Motl.
431    All rights reserved.
432    
433    You may distribute it under the terms of either the GNU General Public
434    License or the Artistic License, as specified in the Perl README file.
435    
436    
437    =head1 ACKNOWLEDGEMENTS
438    
439    Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,
440    Sam Vilain for Class::Tangram, Jochen Wiedmann and Jeff Zucker for DBD::CSV and related,
441    Adam Spiers for MySQL::Diff and all contributors.
442    
443    
444    =head1 SUPPORT / WARRANTY
445    
446    Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.
447    
448    
449    =head1 TODO
450    
451    
452    =head2 BUGS
453    
454    "DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"
455    
456      ... occours when operating on object-attributes not introduced yet:
457      this should be detected and appended/replaced through:
458      "Schema-Error detected, maybe (just) an inconsistency.
459      Please check if your declaration in schema-module "a" matches structure in database "b" or try to run"
460      db_setup.pl --dbkey=import --action=deploy
461    
462    
463    Compare schema (structure diff) with database ...
464    
465      ... when issuing "db_setup.pl --dbkey=import --action=deploy"
466      on a database with an already deployed schema, use an additional "--update" then
467      to lift the schema inside the database to the current declared schema.
468      You will have to approve removals and changes on field-level while
469      new objects and new fields are introduced silently without any interaction needed.
470      In future versions there may be additional options to control silent processing of
471      removals and changes.
472      See this CRUD-table applying to the actions occouring on Classes and Class variables when deploying schemas,
473      don't mix this up with CRUD-actions on Objects, these are already handled by (e.g.) Tangram itself.
474      Classes:
475        C create    ->  yes, handled automatically
476        R retrieve  ->  no, not subject of this aspect since it is about deployment only
477        U update    ->  yes, automatically for Class meta-attributes, yes/no for Class variables (look at the rules down here)
478        D delete    ->  yes, just by user-interaction
479      Class variables:
480        C create    ->  yes, handled automatically
481        R retrieve  ->  no, not subject of this aspect since it is about deployment only
482        U update    ->  yes, just by user-interaction; maybe automatically if it can be determined that data wouldn't be lost
483        D delete    ->  yes, just by user-interaction
484      
485      It's all about not to be able to loose data simply while this is in pre-alpha stage.
486      And loosing data by being able to modify and redeploy schemas easily is definitely quite easy.
487      
488      As we can see, creations of Classes and new Class variables is handled
489      automatically and this is believed to be the most common case under normal circumstances.
490    
491    
492    =head2 FEATURES
493    
494      - Get this stuff together with UML (Unified Modeling Language) and/or standards from ODMG.
495      - Make it possible to load/save schemas in XMI (XML Metadata Interchange),
496        which seems to be most commonly used today, perhaps handle objects with OIFML.
497        Integrate/bundle this with a web-/html-based UML modeling tool or
498        some other interesting stuff like the "Co-operative UML Editor" from Uni Darmstadt. (web-/java-based)
499      - Enable Round Trip Engineering. Keep code and diagrams in sync. Don't annoy/bother the programmers.
500      - Add support for some more handlers/locators to be able to
501         access the following standards/protocols/interfaces/programs/apis transparently:
502        +  DBD::CSV (via Data::Storage::Handler::DBI)
503       (-) Text::CSV, XML::CSV, XML::Excel
504        -  MAPI
505        -  LDAP
506        -  DAV (look at PerlDAV: http://www.webdav.org/perldav/)
507        -  Mbox (use formail for seperating/splitting entries/nodes)
508        -  Cyrus (cyrdeliver - what about cyrretrieve (export)???)
509        -  use File::DiffTree, use File::Compare
510        -  Hibernate
511        -  "Win32::UserAccountDb"
512        -  "*nix::UserAccountDb"
513        -  .wab - files (Windows Address Book)
514        -  .pst - files (Outlook Post Storage?)
515        -  XML (e.g. via XML::Simple?)
516      - Move to t3, look at InCASE
517    
518    
519    =head3 LINKS / REFERENCES
520    
521      Specs:
522        UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf
523        XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf
524        XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf
525        ODMG: http://odmg.org/
526        OIFML: http://odmg.org/library/readingroom/oifml.pdf
527    
528      CASE Tools:
529        Rational Rose (commercial): http://www.rational.com/products/rose/
530        Together (commercial): http://www.oi.com/products/controlcenter/index.jsp
531        InCASE - Tangram-based Universal Object Editor
532        Sybase PowerDesigner: http://www.sybase.com/powerdesigner
533      
534      UML Editors:
535        Fujaba (free, university): http://www.fujaba.de/
536        ArgoUML (free): http://argouml.tigris.org/
537        Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3
538        Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html
539        Metamill (commercial): http://www.metamill.com/
540        Violet (university, research, education): http://www.horstmann.com/violet/
541        PyUt (free): http://pyut.sourceforge.net/
542        (Dia (free): http://www.lysator.liu.se/~alla/dia/)
543        UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html
544        Voodoo (free): http://voodoo.sourceforge.net/
545        Umbrello UML Modeller: http://uml.sourceforge.net/
546    
547      UML Tools:
548        http://www.objectsbydesign.com/tools/umltools_byPrice.html
549    
550      Further readings:
551        http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N
552        http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf
553        http://www.enhyper.com/src/documentation/
554        http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf
555        http://citeseer.nj.nec.com/vilain00diagrammatic.html
556        http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp
557    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed