libs/Data/Storage.pm

# $Id: Storage.pm,v 1.8 2002/11/29 04:48:23 joko Exp $
#
# Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#
############################################
#
#  $Log: Storage.pm,v $
#  Revision 1.8  2002/11/29 04:48:23  joko
#  + updated pod
#
#  Revision 1.7  2002/11/17 06:07:18  joko
#  + creating the handler is easier than proposed first - for now :-)
#  + sub testAvailability
#
#  Revision 1.6  2002/11/09 01:04:58  joko
#  + updated pod
#
#  Revision 1.5  2002/10/29 19:24:18  joko
#  - reduced logging
#  + added some pod
#
#  Revision 1.4  2002/10/27 18:35:07  joko
#  + added pod
#
#  Revision 1.3  2002/10/25 11:40:37  joko
#  + enhanced robustness
#  + more logging for debug-levels
#  + sub dropDb
#
#  Revision 1.2  2002/10/17 00:04:29  joko
#  + sub createDb
#  + sub isConnected
#  + bugfixes regarding "deep recursion" stuff
#
#  Revision 1.1  2002/10/10 03:43:12  cvsjoko
#  + new
#
############################################


BEGIN {
  $Data::Storage::VERSION = 0.02;
}


=head1 NAME

Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way


=head1 AIMS

  - should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary (more convenient) way ;)
  - introduce a generic layered structure, refactor *SUBLAYER*-stuff, make (e.g.) this possible:
    Perl Data::Storage[DBD::CSV]  ->  Perl LWP::  ->  Internet HTTP/FTP/*  ->  Host Daemon  ->  csv-file
  - provide generic synchronization mechanisms across arbitrary/multiple storages based on ident/checksum
    maybe it's possible to have schema-, structural- and semantical modifications synchronized???


=head1 SYNOPSIS

=head2 BASIC ACCESS

=head2 ADVANCED ACCESS

  ... via inheritance:
  
    use Data::Storage;
    my $proxyObj = new HttpProxy;
    $proxyObj->{url} = $url;
    $proxyObj->{payload} = $content;
    $self->{storage}->insert($proxyObj);
    
    use Data::Storage;
    my $proxyObj = HttpProxy->new(
      url => $url,
      payload => $content,
    );
    $self->{storage}->insert($proxyObj);


=head2 SYNCHRONIZATION

  my $nodemapping = {
    'LangText' => 'langtexts.csv',
    'Currency' => 'currencies.csv',
    'Country'  => 'countries.csv',
  };

  my $propmapping = {
    'LangText' => [
      [ 'source:lcountrykey'  =>  'target:country' ],
      [ 'source:lkey'         =>  'target:key' ],
      [ 'source:lvalue'       =>  'target:text' ],
    ],
    'Currency' => [
      [ 'source:ckey'         =>  'target:key' ],
      [ 'source:cname'        =>  'target:text' ],
    ],
    'Country' => [
      [ 'source:ckey'         =>  'target:key' ],
      [ 'source:cname'        =>  'target:text' ],
    ],
  };

  sub syncResource {

    my $self = shift;
    my $node_source = shift;
    my $mode = shift;
    my $opts = shift;
    
    $mode ||= '';
    $opts->{erase} ||= 0;
    
    $logger->info( __PACKAGE__ . "->syncResource( node_source $node_source mode $mode erase $opts->{erase} )");
  
    # resolve metadata for syncing requested resource
    my $node_target = $nodemapping->{$node_source};
    my $mapping = $propmapping->{$node_source};
    
    if (!$node_target || !$mapping) {
      # loggger.... "no target, sorry!"
      print "error while resolving resource metadata", "\n";
      return;
    }
    
    if ($opts->{erase}) {
      $self->_erase_all($node_source);
    }
  
    # create new sync object
    my $sync = Data::Transfer::Sync->new( 
      storages => {
        L => $self->{bizWorks}->{backend},
        R => $self->{bizWorks}->{resources},
      },
      id_authorities        =>  [qw( L ) ],
      checksum_authorities  =>  [qw( L ) ],
      write_protected       =>  [qw( R ) ],
      verbose               =>  1,
    );
    
    # sync
    # todo: filter!?
    $sync->syncNodes( {
      direction       =>  $mode,                 # | +PUSH | +PULL | -FULL | +IMPORT | -EXPORT
      method          =>  'checksum',            # | -timestamp | -manual
      source          =>  "L:$node_source",
      source_ident    =>  'storage_method:id',
      source_exclude  =>  [qw( id cs )],
      target          =>  "R:$node_target",
      target_ident    =>  'property:oid',
      mapping         =>  $mapping,
    } );

  }


=head2 NOTE

This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks. 
Please look at their documentation and/or this code for additional information.


=head1 REQUIREMENTS

  For full functionality:
    DBI              from CPAN
    DBD::mysql       from CPAN
    Tangram 2.04     from CPAN         (hmmm, 2.04 won't do in some cases)
    Tangram 2.05     from http://...   (2.05 seems okay but there are also additional patches from our side)
    Class::Tangram   from CPAN
    DBD::CSV         from CPAN
    MySQL::Diff      from http://adamspiers.org/computing/mysqldiff/
    ... and all their dependencies

=cut

# The POD text continues at the end of the file.


package Data::Storage;

use strict;
use warnings;

use Data::Storage::Locator;
use Data::Dumper;

# TODO: actually implement level (integrate with Log::Dispatch)
my $TRACELEVEL = 0;

# get logger instance
my $logger = Log::Dispatch::Config->instance;

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  #my @args = normalizeArgs(@_);

  my $arg_locator = shift;
  my $arg_options = shift;

  #my $self = { STORAGEHANDLE => undef, @_ };
  my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
  #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
  $logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
  return bless $self, $class;
}

sub AUTOLOAD {
  
  # since this is a core function acting as dispatcher to $self->{STORAGEHANDLE},
  # some sophisticated handling and filtering is needed to avoid things like
  #     - Deep recursion on subroutine "Data::Storage::AUTOLOAD"
  #     - Deep recursion on subroutine "Data::Storage::Handler::Abstract::AUTOLOAD"
  #     - Deep recursion on anonymous subroutine at [...]
  # we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
  
  my $self = shift;
  our $AUTOLOAD;
  
  # ->DESTROY would - if not declared - trigger an AUTOLOAD also
  return if $AUTOLOAD =~ m/::DESTROY$/;

  my $method = $AUTOLOAD;
  $method =~ s/^.*:://;

  # advanced logging of AUTOLOAD calls ...
  # ... nice but do it only when TRACING (TODO) is enabled
    if ($TRACELEVEL) {
      my $logstring = "";
      $logstring .= __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method;
      #print "count: ", $#_, "\n";
      #$logstring .= Dumper(@_) if ($#_ != -1);
      my $tabcount = int( (80 - length($logstring)) / 10 );
      $logstring .= "\t" x $tabcount . "(AUTOLOAD)";
      # TODO: only ok if logstring doesn't contain 
      #            e.g. "Data::Storage[Tangram]->insert(SystemEvent=HASH(0x5c0034c))          (AUTOLOAD)"
      # but that would be _way_ too specific as long as we don't have an abstract handler for this  ;)
      $logger->debug( $logstring );
      #print join('; ', @_);
    }
    
  # filtering AUTOLOAD calls and first-time-touch of the actual storage impl
  if ($self->_filter_AUTOLOAD($method)) {
    #print "_accessStorage\n";
    $self->_accessStorage();
    $self->{STORAGEHANDLE}->$method(@_);
  }
  
}

sub _filter_AUTOLOAD {
  my $self = shift;
  my $method = shift;
  if ($self->{options}->{protected}) {
    if ($method eq 'disconnect') {
      return;
    }
  }
  return 1;
}


sub normalizeArgs {
  my %args = @_;
  if (!$args{dsn} && $args{meta}{dsn}) {
    $args{dsn} = $args{meta}{dsn};
  }
  my @result = %args;
  return @result;
}

sub _accessStorage {
  my $self = shift;
  # TODO: to some tracelevel!
  if ($TRACELEVEL) {
    $logger->debug( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->_accessStorage()" );
  }
  if (!$self->{STORAGEHANDLE}) {
    $self->_createStorageHandle();
  }
}

sub _createStorageHandle {
  my $self = shift;
  my $type = $self->{locator}->{type};
  $logger->debug( __PACKAGE__ .  "[$type]" . "->_createStorageHandle()" );

  my $pkg = "Data::Storage::Handler::" . $type . "";
  
  # try to load perl module at runtime
  my $evalstr = "use $pkg;";
  eval($evalstr);
  if ($@) {
    $logger->error( __PACKAGE__ .  "[$type]" . "->_createStorageHandle(): $@" );
    return;
  }
  
  # build up some additional arguments to pass on
  #my @args = %{$self->{locator}};
  my @args = ();

  # - create new storage handle object
  # - propagate arguments to handler
  # - pass locator by reference to be able to store status- or meta-information in it
  $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );

}

sub addLogDispatchHandler {

      my $self = shift;
      my $name = shift;
      my $package = shift;
      my $logger1 = shift;
      my $objectCreator = shift;
      
      #$logger->add( Log::Dispatch::Tangram->new( name => $name,
      $logger->add( $package->new( name => $name,
                                            #min_level => 'debug',
                                            min_level => 'info',
                                            storage => $self,
                                            objectCreator => $objectCreator,
                                            fields => {
                                              message => 'usermsg',
                                              timestamp => 'stamp',
                                              level => 'level',
                                              name => 'code',
                                            },
                                            filter_patterns => [ '->insert\(SystemEvent=' ],
                                            #filter_patterns => [ 'SystemEvent' ],
                                            
                                            #format  => '[%d] [%p] %m%n',
                                             ) );

}

sub removeLogDispatchHandler {
  my $self = shift;
  my $name = shift;
  #my $logger = shift;
  $logger->remove($name);
}

sub getDbName {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  $dsn =~ m/database=(.+?);/;
  my $database_name = $1;
  return $database_name;
}

sub testDsn {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    
    # TODO: REVIEW
    $dbh->disconnect();
    
    return 1;
  } else {
    $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
  }
}

sub testAvailability {
  my $self = shift;
  my $status = $self->testDsn();
  $self->{locator}->{status}->{available} = $status;
  return $status;
}


sub dropDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("DROP DATABASE $database_name;")) {
        $ok = 1;
      }
    }

    $dbh->disconnect();

  }
  
  return $ok;
}

sub isConnected {
  my $self = shift;
  return 1 if $self->{STORAGEHANDLE};
}

1;
__END__


=head1 DESCRIPTION

Data::Storage is a module for accessing various "data structures" stored inside
various "data containers". It sits on top of DBI and/or Tangram.


=head1 AUTHORS / COPYRIGHT

The Data::Storage module is Copyright (c) 2002 Andreas Motl.
All rights reserved.

You may distribute it under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.


=head1 ACKNOWLEDGEMENTS

Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object, 
Sam Vilain for Class::Tangram, Jochen Wiedmann and Jeff Zucker for DBD::CSV and related,
Adam Spiers for MySQL::Diff and all contributors.


=head1 SUPPORT / WARRANTY

Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.


=head1 TODO


=head2 BUGS

"DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"

  ... occours when operating on object-attributes not introduced yet:
  this should be detected and appended/replaced through:
  "Schema-Error detected, maybe (just) an inconsistency. 
  Please check if your declaration in schema-module "a" matches structure in database "b" or try to run"
  db_setup.pl --dbkey=import --action=deploy


Compare schema (structure diff) with database ... 

  ... when issuing "db_setup.pl --dbkey=import --action=deploy"
  on a database with an already deployed schema, use an additional "--update" then
  to lift the schema inside the database to the current declared schema.
  You will have to approve removals and changes on field-level while
  new objects and new fields are introduced silently without any interaction needed.
  In future versions there may be additional options to control silent processing of
  removals and changes.
  See this CRUD-table applying to the actions occouring on Classes and Class variables when deploying schemas,
  don't mix this up with CRUD-actions on Objects, these are already handled by (e.g.) Tangram itself.
  Classes:
    C create    ->  yes, handled automatically
    R retrieve  ->  no, not subject of this aspect since it is about deployment only
    U update    ->  yes, automatically for Class meta-attributes, yes/no for Class variables (look at the rules down here)
    D delete    ->  yes, just by user-interaction
  Class variables:
    C create    ->  yes, handled automatically
    R retrieve  ->  no, not subject of this aspect since it is about deployment only
    U update    ->  yes, just by user-interaction; maybe automatically if it can be determined that data wouldn't be lost
    D delete    ->  yes, just by user-interaction
  
  It's all about not to be able to loose data simply while this is in pre-alpha stage.
  And loosing data by being able to modify and redeploy schemas easily is definitely quite easy.
  
  As we can see, creations of Classes and new Class variables is handled 
  automatically and this is believed to be the most common case under normal circumstances.


=head2 FEATURES

  - Get this stuff together with UML (Unified Modeling Language) and/or standards from ODMG.
  - Make it possible to load/save schemas in XMI (XML Metadata Interchange), 
    which seems to be most commonly used today, perhaps handle objects with OIFML.
    Integrate/bundle this with a web-/html-based UML modeling tool or 
    some other interesting stuff like the "Co-operative UML Editor" from Uni Darmstadt. (web-/java-based)
  - Enable Round Trip Engineering. Keep code and diagrams in sync. Don't annoy/bother the programmers.
  - Add support for some more handlers/locators to be able to 
     access the following standards/protocols/interfaces/programs/apis transparently:
    +  DBD::CSV (via Data::Storage::Handler::DBI)
   (-) Text::CSV, XML::CSV, XML::Excel
    -  MAPI
    -  LDAP
    -  DAV (look at PerlDAV: http://www.webdav.org/perldav/)
    -  Mbox (use formail for seperating/splitting entries/nodes)
    -  Cyrus (cyrdeliver - what about cyrretrieve (export)???)
    -  use File::DiffTree, use File::Compare
    -  Hibernate
    -  "Win32::UserAccountDb"
    -  "*nix::UserAccountDb"
    -  .wab - files (Windows Address Book)
    -  .pst - files (Outlook Post Storage?)
    -  XML (e.g. via XML::Simple?)
  - Move to t3, look at InCASE


=head3 LINKS / REFERENCES

  Specs:
    UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf
    XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf
    XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf
    ODMG: http://odmg.org/
    OIFML: http://odmg.org/library/readingroom/oifml.pdf

  CASE Tools:
    Rational Rose (commercial): http://www.rational.com/products/rose/
    Together (commercial): http://www.oi.com/products/controlcenter/index.jsp
    InCASE - Tangram-based Universal Object Editor 
    Sybase PowerDesigner: http://www.sybase.com/powerdesigner
  
  UML Editors:
    Fujaba (free, university): http://www.fujaba.de/
    ArgoUML (free): http://argouml.tigris.org/
    Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3
    Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html
    Metamill (commercial): http://www.metamill.com/
    Violet (university, research, education): http://www.horstmann.com/violet/
    PyUt (free): http://pyut.sourceforge.net/
    (Dia (free): http://www.lysator.liu.se/~alla/dia/)
    UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html
    Voodoo (free): http://voodoo.sourceforge.net/
    Umbrello UML Modeller: http://uml.sourceforge.net/

  UML Tools:
    http://www.objectsbydesign.com/tools/umltools_byPrice.html

  Further readings:
    http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N
    http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf
    http://www.enhyper.com/src/documentation/
    http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf
    http://citeseer.nj.nec.com/vilain00diagrammatic.html
    http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp

1	joko	1.9	# $Id: Storage.pm,v 1.8 2002/11/29 04:48:23 joko Exp $
2	joko	1.4	#
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	joko	1.8	############################################
8	cvsjoko	1.1	#
9	joko	1.4	# $Log: Storage.pm,v $
10	joko	1.9	# Revision 1.8 2002/11/29 04:48:23 joko
11			# + updated pod
12			#
13	joko	1.8	# 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	joko	1.7	# Revision 1.6 2002/11/09 01:04:58 joko
18			# + updated pod
19			#
20	joko	1.6	# Revision 1.5 2002/10/29 19:24:18 joko
21			# - reduced logging
22			# + added some pod
23			#
24	joko	1.5	# Revision 1.4 2002/10/27 18:35:07 joko
25			# + added pod
26			#
27	joko	1.4	# Revision 1.3 2002/10/25 11:40:37 joko
28			# + enhanced robustness
29			# + more logging for debug-levels
30			# + sub dropDb
31	joko	1.2	#
32	joko	1.3	# Revision 1.2 2002/10/17 00:04:29 joko
33			# + sub createDb
34			# + sub isConnected
35			# + bugfixes regarding "deep recursion" stuff
36			#
37	joko	1.2	# Revision 1.1 2002/10/10 03:43:12 cvsjoko
38			# + new
39	cvsjoko	1.1	#
40	joko	1.8	############################################
41	cvsjoko	1.1
42	joko	1.3
43	joko	1.4	BEGIN {
44	joko	1.8	$Data::Storage::VERSION = 0.02;
45	joko	1.4	}
46
47	joko	1.5
48	joko	1.4	=head1 NAME
49
50			Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way
51
52	joko	1.8
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	joko	1.4	=head1 SYNOPSIS
63
64	joko	1.8	=head2 BASIC ACCESS
65	joko	1.4
66	joko	1.8	=head2 ADVANCED ACCESS
67	joko	1.4
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	joko	1.8	=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	joko	1.4	=head2 NOTE
163
164			This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks.
165	joko	1.6	Please look at their documentation and/or this code for additional information.
166
167
168			=head1 REQUIREMENTS
169	joko	1.4
170	joko	1.8	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	joko	1.4
180			=cut
181
182			# The POD text continues at the end of the file.
183
184
185	cvsjoko	1.1	package Data::Storage;
186
187			use strict;
188			use warnings;
189
190			use Data::Storage::Locator;
191	joko	1.7	use Data::Dumper;
192	cvsjoko	1.1
193	joko	1.6	# TODO: actually implement level (integrate with Log::Dispatch)
194	joko	1.5	my $TRACELEVEL = 0;
195
196	cvsjoko	1.1	# get logger instance
197			my $logger = Log::Dispatch::Config->instance;
198
199			sub new {
200			my $invocant = shift;
201			my $class = ref($invocant) \|\| $invocant;
202			#my @args = normalizeArgs(@_);
203	joko	1.7
204	cvsjoko	1.1	my $arg_locator = shift;
205			my $arg_options = shift;
206	joko	1.7
207	cvsjoko	1.1	#my $self = { STORAGEHANDLE => undef, @_ };
208			my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
209	joko	1.7	#$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
210			$logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
211	cvsjoko	1.1	return bless $self, $class;
212			}
213
214			sub AUTOLOAD {
215
216	joko	1.2	# 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	joko	1.8	# we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
222	joko	1.2
223	cvsjoko	1.1	my $self = shift;
224			our $AUTOLOAD;
225
226			# ->DESTROY would - if not declared - trigger an AUTOLOAD also
227			return if $AUTOLOAD =~ m/::DESTROY$/;
228
229			my $method = $AUTOLOAD;
230			$method =~ s/^.*:://;
231
232	joko	1.5	# 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	joko	1.8	# but that would be _way_ too specific as long as we don't have an abstract handler for this ;)
244	joko	1.5	$logger->debug( $logstring );
245	joko	1.7	#print join('; ', @_);
246	joko	1.5	}
247
248	joko	1.8	# filtering AUTOLOAD calls and first-time-touch of the actual storage impl
249	cvsjoko	1.1	if ($self->_filter_AUTOLOAD($method)) {
250	joko	1.7	#print "_accessStorage\n";
251	cvsjoko	1.1	$self->_accessStorage();
252			$self->{STORAGEHANDLE}->$method(@_);
253			}
254
255			}
256
257			sub _filter_AUTOLOAD {
258			my $self = shift;
259			my $method = shift;
260			if ($self->{options}->{protected}) {
261			if ($method eq 'disconnect') {
262			return;
263			}
264			}
265			return 1;
266			}
267
268
269			sub normalizeArgs {
270			my %args = @_;
271			if (!$args{dsn} && $args{meta}{dsn}) {
272			$args{dsn} = $args{meta}{dsn};
273			}
274			my @result = %args;
275			return @result;
276			}
277
278			sub _accessStorage {
279			my $self = shift;
280			# TODO: to some tracelevel!
281	joko	1.5	if ($TRACELEVEL) {
282			$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" );
283			}
284	cvsjoko	1.1	if (!$self->{STORAGEHANDLE}) {
285			$self->_createStorageHandle();
286			}
287			}
288
289			sub _createStorageHandle {
290			my $self = shift;
291			my $type = $self->{locator}->{type};
292			$logger->debug( __PACKAGE__ . "[$type]" . "->_createStorageHandle()" );
293
294			my $pkg = "Data::Storage::Handler::" . $type . "";
295
296	joko	1.7	# try to load perl module at runtime
297			my $evalstr = "use $pkg;";
298			eval($evalstr);
299			if ($@) {
300			$logger->error( __PACKAGE__ . "[$type]" . "->_createStorageHandle(): $@" );
301			return;
302	cvsjoko	1.1	}
303	joko	1.7
304			# build up some additional arguments to pass on
305			#my @args = %{$self->{locator}};
306			my @args = ();
307
308	joko	1.8	# - 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	joko	1.7	$self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
312	joko	1.3
313	cvsjoko	1.1	}
314
315			sub addLogDispatchHandler {
316
317			my $self = shift;
318			my $name = shift;
319			my $package = shift;
320	joko	1.3	my $logger1 = shift;
321	cvsjoko	1.1	my $objectCreator = shift;
322
323			#$logger->add( Log::Dispatch::Tangram->new( name => $name,
324			$logger->add( $package->new( name => $name,
325			#min_level => 'debug',
326			min_level => 'info',
327			storage => $self,
328			objectCreator => $objectCreator,
329			fields => {
330			message => 'usermsg',
331			timestamp => 'stamp',
332			level => 'level',
333			name => 'code',
334			},
335			filter_patterns => [ '->insert\(SystemEvent=' ],
336			#filter_patterns => [ 'SystemEvent' ],
337
338			#format => '[%d] [%p] %m%n',
339			) );
340
341			}
342
343			sub removeLogDispatchHandler {
344	joko	1.8	my $self = shift;
345			my $name = shift;
346			#my $logger = shift;
347			$logger->remove($name);
348	cvsjoko	1.1	}
349
350			sub getDbName {
351			my $self = shift;
352			my $dsn = $self->{locator}->{dbi}->{dsn};
353			$dsn =~ m/database=(.+?);/;
354			my $database_name = $1;
355			return $database_name;
356			}
357
358			sub testDsn {
359			my $self = shift;
360			my $dsn = $self->{locator}->{dbi}->{dsn};
361			my $result;
362			if ( my $dbh = DBI->connect($dsn, '', '', {
363			PrintError => 0,
364			} ) ) {
365	joko	1.9
366			# TODO: REVIEW
367	cvsjoko	1.1	$dbh->disconnect();
368	joko	1.9
369	cvsjoko	1.1	return 1;
370			} else {
371	joko	1.7	$logger->warning( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
372	joko	1.2	}
373	joko	1.7	}
374
375			sub testAvailability {
376			my $self = shift;
377			my $status = $self->testDsn();
378			$self->{locator}->{status}->{available} = $status;
379			return $status;
380	joko	1.2	}
381
382	joko	1.3
383			sub dropDb {
384			my $self = shift;
385			my $dsn = $self->{locator}->{dbi}->{dsn};
386
387			$logger->debug( __PACKAGE__ . "->dropDb( dsn $dsn )" );
388
389			$dsn =~ s/database=(.+?);//;
390			my $database_name = $1;
391
392			my $ok;
393
394			if ( my $dbh = DBI->connect($dsn, '', '', {
395			PrintError => 0,
396			} ) ) {
397			if ($database_name) {
398			if ($dbh->do("DROP DATABASE $database_name;")) {
399			$ok = 1;
400			}
401			}
402	joko	1.9
403	joko	1.3	$dbh->disconnect();
404	joko	1.9
405	joko	1.3	}
406
407			return $ok;
408	joko	1.2	}
409
410			sub isConnected {
411			my $self = shift;
412			return 1 if $self->{STORAGEHANDLE};
413	cvsjoko	1.1	}
414
415	joko	1.4	1;
416			__END__
417
418
419			=head1 DESCRIPTION
420
421	joko	1.8	Data::Storage is a module for accessing various "data structures" stored inside
422	joko	1.4	various "data containers". It sits on top of DBI and/or Tangram.
423
424
425			=head1 AUTHORS / COPYRIGHT
426
427			The Data::Storage module is Copyright (c) 2002 Andreas Motl.
428			All rights reserved.
429
430			You may distribute it under the terms of either the GNU General Public
431			License or the Artistic License, as specified in the Perl README file.
432
433
434			=head1 ACKNOWLEDGEMENTS
435
436	joko	1.6	Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,
437	joko	1.8	Sam Vilain for Class::Tangram, Jochen Wiedmann and Jeff Zucker for DBD::CSV and related,
438			Adam Spiers for MySQL::Diff and all contributors.
439	joko	1.4
440
441			=head1 SUPPORT / WARRANTY
442
443			Data::Storage is free software. IT COMES WITHOUT WARRANTY OF ANY KIND.
444
445
446			=head1 TODO
447
448
449	joko	1.8	=head2 BUGS
450
451			"DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"
452	joko	1.4
453	joko	1.8	... occours when operating on object-attributes not introduced yet:
454			this should be detected and appended/replaced through:
455			"Schema-Error detected, maybe (just) an inconsistency.
456			Please check if your declaration in schema-module "a" matches structure in database "b" or try to run"
457			db_setup.pl --dbkey=import --action=deploy
458	joko	1.4
459
460	joko	1.8	Compare schema (structure diff) with database ...
461	joko	1.4
462			... when issuing "db_setup.pl --dbkey=import --action=deploy"
463			on a database with an already deployed schema, use an additional "--update" then
464			to lift the schema inside the database to the current declared schema.
465			You will have to approve removals and changes on field-level while
466			new objects and new fields are introduced silently without any interaction needed.
467			In future versions there may be additional options to control silent processing of
468			removals and changes.
469			See this CRUD-table applying to the actions occouring on Classes and Class variables when deploying schemas,
470			don't mix this up with CRUD-actions on Objects, these are already handled by (e.g.) Tangram itself.
471			Classes:
472			C create -> yes, handled automatically
473			R retrieve -> no, not subject of this aspect since it is about deployment only
474			U update -> yes, automatically for Class meta-attributes, yes/no for Class variables (look at the rules down here)
475			D delete -> yes, just by user-interaction
476			Class variables:
477			C create -> yes, handled automatically
478			R retrieve -> no, not subject of this aspect since it is about deployment only
479			U update -> yes, just by user-interaction; maybe automatically if it can be determined that data wouldn't be lost
480			D delete -> yes, just by user-interaction
481	joko	1.5
482			It's all about not to be able to loose data simply while this is in pre-alpha stage.
483			And loosing data by being able to modify and redeploy schemas easily is definitely quite easy.
484
485			As we can see, creations of Classes and new Class variables is handled
486			automatically and this is believed to be the most common case under normal circumstances.
487	joko	1.4
488
489	joko	1.8	=head2 FEATURES
490	joko	1.4
491	joko	1.5	- Get this stuff together with UML (Unified Modeling Language) and/or standards from ODMG.
492			- Make it possible to load/save schemas in XMI (XML Metadata Interchange),
493			which seems to be most commonly used today, perhaps handle objects with OIFML.
494			Integrate/bundle this with a web-/html-based UML modeling tool or
495			some other interesting stuff like the "Co-operative UML Editor" from Uni Darmstadt. (web-/java-based)
496			- Enable Round Trip Engineering. Keep code and diagrams in sync. Don't annoy/bother the programmers.
497	joko	1.8	- Add support for some more handlers/locators to be able to
498			access the following standards/protocols/interfaces/programs/apis transparently:
499			+ DBD::CSV (via Data::Storage::Handler::DBI)
500			(-) Text::CSV, XML::CSV, XML::Excel
501			- MAPI
502			- LDAP
503			- DAV (look at PerlDAV: http://www.webdav.org/perldav/)
504			- Mbox (use formail for seperating/splitting entries/nodes)
505			- Cyrus (cyrdeliver - what about cyrretrieve (export)???)
506			- use File::DiffTree, use File::Compare
507			- Hibernate
508			- "Win32::UserAccountDb"
509			- "*nix::UserAccountDb"
510			- .wab - files (Windows Address Book)
511			- .pst - files (Outlook Post Storage?)
512			- XML (e.g. via XML::Simple?)
513			- Move to t3, look at InCASE
514	joko	1.4
515
516	joko	1.8	=head3 LINKS / REFERENCES
517	joko	1.4
518	joko	1.5	Specs:
519	joko	1.4	UML 1.3 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-06-08.pdf
520			XMI 1.1 Spec: http://cgi.omg.org/cgi-bin/doc?ad/99-10-02.pdf
521			XMI 2.0 Spec: http://cgi.omg.org/docs/ad/01-06-12.pdf
522			ODMG: http://odmg.org/
523			OIFML: http://odmg.org/library/readingroom/oifml.pdf
524
525	joko	1.5	CASE Tools:
526			Rational Rose (commercial): http://www.rational.com/products/rose/
527			Together (commercial): http://www.oi.com/products/controlcenter/index.jsp
528			InCASE - Tangram-based Universal Object Editor
529			Sybase PowerDesigner: http://www.sybase.com/powerdesigner
530
531			UML Editors:
532			Fujaba (free, university): http://www.fujaba.de/
533			ArgoUML (free): http://argouml.tigris.org/
534			Poseidon (commercial): http://www.gentleware.com/products/poseidonDE.php3
535			Co-operative UML Editor (research): http://www.darmstadt.gmd.de/concert/activities/internal/umledit.html
536			Metamill (commercial): http://www.metamill.com/
537			Violet (university, research, education): http://www.horstmann.com/violet/
538			PyUt (free): http://pyut.sourceforge.net/
539			(Dia (free): http://www.lysator.liu.se/~alla/dia/)
540			UMLet (free, university): http://www.swt.tuwien.ac.at/umlet/index.html
541			Voodoo (free): http://voodoo.sourceforge.net/
542	joko	1.6	Umbrello UML Modeller: http://uml.sourceforge.net/
543	joko	1.5
544			UML Tools:
545			http://www.objectsbydesign.com/tools/umltools_byPrice.html
546
547			Further readings:
548	joko	1.4	http://www.google.com/search?q=web+based+uml+editor&hl=en&lr=&ie=UTF-8&oe=UTF-8&start=10&sa=N
549			http://www.fernuni-hagen.de/DVT/Aktuelles/01FHHeidelberg.pdf
550			http://www.enhyper.com/src/documentation/
551			http://cis.cs.tu-berlin.de/Dokumente/Diplomarbeiten/2001/skinner.pdf
552			http://citeseer.nj.nec.com/vilain00diagrammatic.html
553			http://archive.devx.com/uml/articles/Smith01/Smith01-3.asp
554
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26