libs/Data/Storage.pm

# $Id: Storage.pm,v 1.12 2002/12/12 02:50:15 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.12  2002/12/12 02:50:15  joko
#  + this now (unfortunately) needs DBI for some helper functions
#  + TODO: these have to be refactored to another scope! (soon!)
#
#  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, ...) )
  - add more hooks and various levels
  - better integrate introduced 'getObjectByGuid'-mechanism from Data::Storage::Handler::Tangram


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