libs/Data/Storage.pm

# $Id: Storage.pm,v 1.11 2002/12/11 06:53:19 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.11  2002/12/11 06:53:19  joko
#  + updated pod
#
#  Revision 1.10  2002/12/07 03:37:23  joko
#  + updated pod
#
#  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: wipe out!
use DBI;

# 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 testAvailability {
  my $self = shift;
  my $status = $self->testDsn();
  $self->{locator}->{status}->{available} = $status;
  return $status;
}

sub isConnected {
  my $self = shift;
  # TODO: REVIEW!
  return 1 if $self->{STORAGEHANDLE};
}

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 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;
}

1;
__END__


=head1 DESCRIPTION

=head2 Data::Storage

  Data::Storage is a module for accessing various "data structures / kinds of structured data" stored inside
  various "data containers".
  We tried to use the AdapterPattern (http://c2.com/cgi/wiki?AdapterPattern) to implement a wrapper-layer
  around core CPAN modules (Tangram, DBI).

=head2 Why?

  You will get a better code-structure (not bad for later maintenance) in growing Perl code projects,
  especially when using multiple database connections at the same time.
  You will be able to switch between different _kinds_ of implementations used for storing data.
  Your code will use the very same API to access these storage layers.
      ... implementation has to be changed for now
  Maybe you will be able to switch "on-the-fly" without changing any bits in code in the future.... 
      ... but that's not the focus

=head2 What else?

  Having this, we were able to do implement a generic data synchronization module more easy,
  please look at Data::Transfer.


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