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