/[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.8 - (show annotations)
Fri Nov 29 04:48:23 2002 UTC (21 years, 7 months ago) by joko
Branch: MAIN
Changes since 1.7: +148 -43 lines
+ updated pod

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

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