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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Tue Dec 17 21:54:12 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.12: +7 -2 lines
+ 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

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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed