libs/Data/Storage.pm

# $Id: Storage.pm,v 1.7 2002/11/17 06:07:18 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.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,
                                                      } ) ) {
    $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 createDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->createDb( 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("CREATE DATABASE $database_name;")) {
        $ok = 1;
      }
    }
    $dbh->disconnect();
  }
  
  return $ok;
  
}

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.8	# $Id: Storage.pm,v 1.7 2002/11/17 06:07:18 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.8	# 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	joko	1.7	# Revision 1.6 2002/11/09 01:04:58 joko
15			# + updated pod
16			#
17	joko	1.6	# Revision 1.5 2002/10/29 19:24:18 joko
18			# - reduced logging
19			# + added some pod
20			#
21	joko	1.5	# Revision 1.4 2002/10/27 18:35:07 joko
22			# + added pod
23			#
24	joko	1.4	# Revision 1.3 2002/10/25 11:40:37 joko
25			# + enhanced robustness
26			# + more logging for debug-levels
27			# + sub dropDb
28	joko	1.2	#
29	joko	1.3	# Revision 1.2 2002/10/17 00:04:29 joko
30			# + sub createDb
31			# + sub isConnected
32			# + bugfixes regarding "deep recursion" stuff
33			#
34	joko	1.2	# Revision 1.1 2002/10/10 03:43:12 cvsjoko
35			# + new
36	cvsjoko	1.1	#
37	joko	1.8	############################################
38	cvsjoko	1.1
39	joko	1.3
40	joko	1.4	BEGIN {
41	joko	1.8	$Data::Storage::VERSION = 0.02;
42	joko	1.4	}
43
44	joko	1.5
45	joko	1.4	=head1 NAME
46
47			Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way
48
49	joko	1.8
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	joko	1.4	=head1 SYNOPSIS
60
61	joko	1.8	=head2 BASIC ACCESS
62	joko	1.4
63	joko	1.8	=head2 ADVANCED ACCESS
64	joko	1.4
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	joko	1.8	=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	joko	1.4	=head2 NOTE
160
161			This module heavily relies on DBI and Tangram, but adds a lot of additional bugs and quirks.
162	joko	1.6	Please look at their documentation and/or this code for additional information.
163
164
165			=head1 REQUIREMENTS
166	joko	1.4
167	joko	1.8	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	joko	1.4
177			=cut
178
179			# The POD text continues at the end of the file.
180
181
182	cvsjoko	1.1	package Data::Storage;
183
184			use strict;
185			use warnings;
186
187			use Data::Storage::Locator;
188	joko	1.7	use Data::Dumper;
189	cvsjoko	1.1
190	joko	1.6	# TODO: actually implement level (integrate with Log::Dispatch)
191	joko	1.5	my $TRACELEVEL = 0;
192
193	cvsjoko	1.1	# 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	joko	1.7
201	cvsjoko	1.1	my $arg_locator = shift;
202			my $arg_options = shift;
203	joko	1.7
204	cvsjoko	1.1	#my $self = { STORAGEHANDLE => undef, @_ };
205			my $self = { STORAGEHANDLE => undef, locator => $arg_locator, options => $arg_options };
206	joko	1.7	#$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->new(@_)" );
207			$logger->debug( __PACKAGE__ . "[$arg_locator->{type}]" . "->new(@_)" );
208	cvsjoko	1.1	return bless $self, $class;
209			}
210
211			sub AUTOLOAD {
212
213	joko	1.2	# 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	joko	1.8	# we also might filter log messages caused by logging to itself in "advanced logging of AUTOLOAD calls"
219	joko	1.2
220	cvsjoko	1.1	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	joko	1.5	# 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	joko	1.8	# but that would be _way_ too specific as long as we don't have an abstract handler for this ;)
241	joko	1.5	$logger->debug( $logstring );
242	joko	1.7	#print join('; ', @_);
243	joko	1.5	}
244
245	joko	1.8	# filtering AUTOLOAD calls and first-time-touch of the actual storage impl
246	cvsjoko	1.1	if ($self->_filter_AUTOLOAD($method)) {
247	joko	1.7	#print "_accessStorage\n";
248	cvsjoko	1.1	$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	joko	1.5	if ($TRACELEVEL) {
279			$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" );
280			}
281	cvsjoko	1.1	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	joko	1.7	# 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	cvsjoko	1.1	}
300	joko	1.7
301			# build up some additional arguments to pass on
302			#my @args = %{$self->{locator}};
303			my @args = ();
304
305	joko	1.8	# - 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	joko	1.7	$self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );
309	joko	1.3
310	cvsjoko	1.1	}
311
312			sub addLogDispatchHandler {
313
314			my $self = shift;
315			my $name = shift;
316			my $package = shift;
317	joko	1.3	my $logger1 = shift;
318	cvsjoko	1.1	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	joko	1.8	my $self = shift;
342			my $name = shift;
343			#my $logger = shift;
344			$logger->remove($name);
345	cvsjoko	1.1	}
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	joko	1.7	$logger->warning( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
366	joko	1.2	}
367	joko	1.7	}
368
369			sub testAvailability {
370			my $self = shift;
371			my $status = $self->testDsn();
372			$self->{locator}->{status}->{available} = $status;
373			return $status;
374	joko	1.2	}
375
376			sub createDb {
377			my $self = shift;
378			my $dsn = $self->{locator}->{dbi}->{dsn};
379	joko	1.3
380			$logger->debug( __PACKAGE__ . "->createDb( dsn $dsn )" );
381
382	joko	1.2	$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	cvsjoko	1.1	}
397	joko	1.2
398			return $ok;
399
400	joko	1.3	}
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	joko	1.2	}
426
427			sub isConnected {
428			my $self = shift;
429			return 1 if $self->{STORAGEHANDLE};
430	cvsjoko	1.1	}
431
432	joko	1.4	1;
433			__END__
434
435
436			=head1 DESCRIPTION
437
438	joko	1.8	Data::Storage is a module for accessing various "data structures" stored inside
439	joko	1.4	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	joko	1.6	Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object,
454	joko	1.8	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	joko	1.4
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	joko	1.8	=head2 BUGS
467
468			"DBI-Error [Tangram]: DBD::mysql::st execute failed: Unknown column 't1.requestdump' in 'field list'"
469	joko	1.4
470	joko	1.8	... 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	joko	1.4
476
477	joko	1.8	Compare schema (structure diff) with database ...
478	joko	1.4
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	joko	1.5
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	joko	1.4
505
506	joko	1.8	=head2 FEATURES
507	joko	1.4
508	joko	1.5	- 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	joko	1.8	- 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	joko	1.4
532
533	joko	1.8	=head3 LINKS / REFERENCES
534	joko	1.4
535	joko	1.5	Specs:
536	joko	1.4	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	joko	1.5	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	joko	1.6	Umbrello UML Modeller: http://uml.sourceforge.net/
560	joko	1.5
561			UML Tools:
562			http://www.objectsbydesign.com/tools/umltools_byPrice.html
563
564			Further readings:
565	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
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