/[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.10 - (show annotations)
Sat Dec 7 03:37:23 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.9: +14 -1 lines
+ updated pod

1 # $Id: Storage.pm,v 1.9 2002/12/01 22:15:45 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.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
31 # + enhanced robustness
32 # + more logging for debug-levels
33 # + sub dropDb
34 #
35 # Revision 1.2 2002/10/17 00:04:29 joko
36 # + sub createDb
37 # + sub isConnected
38 # + bugfixes regarding "deep recursion" stuff
39 #
40 # Revision 1.1 2002/10/10 03:43:12 cvsjoko
41 # + 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
187
188 package Data::Storage;
189
190 use strict;
191 use warnings;
192
193 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
200 my $logger = Log::Dispatch::Config->instance;
201
202 sub new {
203 my $invocant = shift;
204 my $class = ref($invocant) || $invocant;
205 #my @args = normalizeArgs(@_);
206
207 my $arg_locator = shift;
208 my $arg_options = shift;
209
210 #my $self = { STORAGEHANDLE => undef, @_ };
211 my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
212 #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
213 $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
214 return bless $self, $class;
215 }
216
217 sub AUTOLOAD {
218
219 # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
220 # some sophisticated handling and filtering is needed to avoid things like
221 # - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
222 # - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
223 # - Deep recursion on anonymous subroutine at [...]
224 # we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
225
226 my $self = shift;
227 our $AUTOLOAD;
228
229 # ->DESTROY would - if not declared - trigger an AUTOLOAD also
230 return if $AUTOLOAD =~ m/::DESTROY$/;
231
232 my $method = $AUTOLOAD;
233 $method =~ s/^.*:://;
234
235 # advanced logging of AUTOLOAD calls ...
236 # ... nice but do it only when TRACING (TODO) is enabled
237 if ($TRACELEVEL) {
238 my $logstring = "";
239 $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
240 #print "count: ", $#_, "\n";
241 #$logstring .= Dumper(@_) if ($#_ != -1);
242 my $tabcount = int( (80 - length($logstring)) / 10 );
243 $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
244 # TODO: only ok if logstring doesn't contain
245 # 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 $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)) {
253 #print "_accessStorage\n";
254 $self->_accessStorage();
255 $self->{STORAGEHANDLE}->$method(@_);
256 }
257
258 }
259
260 sub _filter_AUTOLOAD {
261 my $self = shift;
262 my $method = shift;
263 if ($self->{options}->{protected}) {
264 if ($method eq 'disconnect') {
265 return;
266 }
267 }
268 return 1;
269 }
270
271
272 sub normalizeArgs {
273 my %args = @_;
274 if (!$args{dsn} && $args{meta}{dsn}) {
275 $args{dsn} = $args{meta}{dsn};
276 }
277 my @result = %args;
278 return @result;
279 }
280
281 sub _accessStorage {
282 my $self = shift;
283 # TODO: to some tracelevel!
284 if ($TRACELEVEL) {
285 $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" );
286 }
287 if (!$self->{STORAGEHANDLE}) {
288 $self->_createStorageHandle();
289 }
290 }
291
292 sub _createStorageHandle {
293 my $self = shift;
294 my $type = $self->{locator}->{type};
295 $logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
296
297 my $pkg = "Data::Storage::Handler::" . $type . "";
298
299 # try to load perl module at runtime
300 my $evalstr = "use $pkg;";
301 eval($evalstr);
302 if ($@) {
303 $logger->error( __PACKAGE__ . "[$type]" . "->_createStorageHandle(): $@" );
304 return;
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 {
319
320 my $self = shift;
321 my $name = shift;
322 my $package = shift;
323 my $logger1 = shift;
324 my $objectCreator = shift;
325
326 #$logger->add( Log::Dispatch::Tangram->new( name => $name,
327 $logger->add( $package->new( name => $name,
328 #min_level => 'debug',
329 min_level => 'info',
330 storage => $self,
331 objectCreator => $objectCreator,
332 fields => {
333 message => 'usermsg',
334 timestamp => 'stamp',
335 level => 'level',
336 name => 'code',
337 },
338 filter_patterns => [ '->insert\(SystemEvent=' ],
339 #filter_patterns => [ 'SystemEvent' ],
340
341 #format => '[%d] [%p] %m%n',
342 ) );
343
344 }
345
346 sub removeLogDispatchHandler {
347 my $self = shift;
348 my $name = shift;
349 #my $logger = shift;
350 $logger->remove($name);
351 }
352
353 sub getDbName {
354 my $self = shift;
355 my $dsn = $self->{locator}->{dbi}->{dsn};
356 $dsn =~ m/database=(.+?);/;
357 my $database_name = $1;
358 return $database_name;
359 }
360
361 sub testDsn {
362 my $self = shift;
363 my $dsn = $self->{locator}->{dbi}->{dsn};
364 my $result;
365 if ( my $dbh = DBI->connect($dsn, '', '', {
366 PrintError => 0,
367 } ) ) {
368
369 # TODO: REVIEW
370 $dbh->disconnect();
371
372 return 1;
373 } else {
374 $logger->warning( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
375 }
376 }
377
378 sub testAvailability {
379 my $self = shift;
380 my $status = $self->testDsn();
381 $self->{locator}->{status}->{available} = $status;
382 return $status;
383 }
384
385
386 sub dropDb {
387 my $self = shift;
388 my $dsn = $self->{locator}->{dbi}->{dsn};
389
390 $logger->debug( __PACKAGE__ . "->dropDb( dsn $dsn )" );
391
392 $dsn =~ s/database=(.+?);//;
393 my $database_name = $1;
394
395 my $ok;
396
397 if ( my $dbh = DBI->connect($dsn, '', '', {
398 PrintError => 0,
399 } ) ) {
400 if ($database_name) {
401 if ($dbh->do("DROP DATABASE $database_name;")) {
402 $ok = 1;
403 }
404 }
405
406 $dbh->disconnect();
407
408 }
409
410 return $ok;
411 }
412
413 sub isConnected {
414 my $self = shift;
415 return 1 if $self->{STORAGEHANDLE};
416 }
417
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 - some kind of security layer for methods/objects
518 - acls (stored via tangram/ldap?) for functions, methods and objects (entity- & data!?)
519 - where are the hooks needed then?
520 - is Data::Storage & Co. okay, or do we have to touch the innards of DBI and/or Tangram?
521 - an attempt to start could be:
522 - 'sub getACLByObjectId($id, $context)'
523 - 'sub getACLByMethodname($id, $context)'
524 - 'sub getACLByName($id, $context)'
525 ( would require a kinda registry to look up these very names pointing to arbitrary locations (code, data, ...) )
526
527
528
529 =head3 LINKS / REFERENCES
530
531 Specs:
532 UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf
533 XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf
534 XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf
535 ODMG: http://odmg.org/
536 OIFML: http://odmg.org/library/readingroom/oifml.pdf
537
538 CASE Tools:
539 Rational Rose (commercial): http://www.rational.com/products/rose/
540 Together (commercial): http://www.oi.com/products/controlcenter/index.jsp
541 InCASE - Tangram-based Universal Object Editor
542 Sybase PowerDesigner: http://www.sybase.com/powerdesigner
543
544 UML Editors:
545 Fujaba (free, university): http://www.fujaba.de/
546 ArgoUML (free): http://argouml.tigris.org/
547 Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3
548 Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html
549 Metamill (commercial): http://www.metamill.com/
550 Violet (university, research, education): http://www.horstmann.com/violet/
551 PyUt (free): http://pyut.sourceforge.net/
552 (Dia (free): http://www.lysator.liu.se/~alla/dia/)
553 UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html
554 Voodoo (free): http://voodoo.sourceforge.net/
555 Umbrello UML Modeller: http://uml.sourceforge.net/
556
557 UML Tools:
558 http://www.objectsbydesign.com/tools/umltools_byPrice.html
559
560 Further readings:
561 http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N
562 http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf
563 http://www.enhyper.com/src/documentation/
564 http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf
565 http://citeseer.nj.nec.com/vilain00diagrammatic.html
566 http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp
567

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