/[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.11 - (show annotations)
Wed Dec 11 06:53:19 2002 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.10: +36 -15 lines
+ updated pod

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

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