libs/Data/Storage.pm

# $Id: Storage.pm,v 1.10 2002/12/07 03:37:23 joko Exp $
#
# Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#
############################################
#
#  $Log: Storage.pm,v $
#  Revision 1.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: 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

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