libs/Data/Storage.pm

# $Id: Storage.pm,v 1.9 2002/12/01 22:15:45 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.9  2002/12/01 22:15:45  joko
#  - sub createDb: moved to handler
#
#  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
  - some kind of security layer for methods/objects
    - acls (stored via tangram/ldap?) for functions, methods and objects (entity- & data!?)
    - where are the hooks needed then?
      - is Data::Storage & Co. okay, or do we have to touch the innards of DBI and/or Tangram?
      - an attempt to start could be: 
         - 'sub getACLByObjectId($id, $context)'
         - 'sub getACLByMethodname($id, $context)'
         - 'sub getACLByName($id, $context)'
            ( would require a kinda registry to look up these very names pointing to arbitrary locations (code, data, ...) )


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