libs/Data/Storage.pm

# $Id: Storage.pm,v 1.6 2002/11/09 01:04:58 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.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
#
#################################

# aim_V1: should encapsulate Tangram, DBI, DBD::CSV and LWP:: to access them in an unordinary way ;)
# aim_V2: 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

BEGIN {
$Data::Storage::VERSION = 0.01;
}


=head1 NAME

Data::Storage - Interface for accessing various Storage implementations for Perl in an independent way

=head1 SYNOPSIS

  ... the basic way:


  ... 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 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
  Tangram          from CPAN
  Class::Tangram   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 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
  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 information in it
  $self->{STORAGEHANDLE} = $pkg->new( locator => $self->{locator}, @args );

}

sub addLogDispatchHandler {

      my $self = shift;
      my $name = shift;
      my $package = shift;
      my $logger1 = shift;
      my $objectCreator = shift;
      
      #$logger->add( Log::Dispatch::Tangram->new( name => $name,
      $logger->add( $package->new( name => $name,
                                            #min_level => 'debug',
                                            min_level => 'info',
                                            storage => $self,
                                            objectCreator => $objectCreator,
                                            fields => {
                                              message => 'usermsg',
                                              timestamp => 'stamp',
                                              level => 'level',
                                              name => 'code',
                                            },
                                            filter_patterns => [ '->insert\(SystemEvent=' ],
                                            #filter_patterns => [ 'SystemEvent' ],
                                            
                                            #format  => '[%d] [%p] %m%n',
                                             ) );

}

sub removeLogDispatchHandler {

      my $self = shift;
      my $name = shift;
      #my $logger = shift;

      $logger->remove($name);

}

sub getDbName {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  $dsn =~ m/database=(.+?);/;
  my $database_name = $1;
  return $database_name;
}

sub testDsn {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    $dbh->disconnect();
    return 1;
  } else {
    $logger->warning( __PACKAGE__ .  "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr );
  }
}

sub testAvailability {
  my $self = shift;
  my $status = $self->testDsn();
  $self->{locator}->{status}->{available} = $status;
  return $status;
}

sub createDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->createDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("CREATE DATABASE $database_name;")) {
        $ok = 1;
      }
    }
    $dbh->disconnect();
  }
  
  return $ok;
  
}

sub dropDb {
  my $self = shift;
  my $dsn = $self->{locator}->{dbi}->{dsn};

  $logger->debug( __PACKAGE__ .  "->dropDb( dsn $dsn )" );

  $dsn =~ s/database=(.+?);//;
  my $database_name = $1;

  my $ok;
  
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    if ($database_name) {
      if ($dbh->do("DROP DATABASE $database_name;")) {
        $ok = 1;
      }
    }
    $dbh->disconnect();
  }
  
  return $ok;
}

sub isConnected {
  my $self = shift;
  return 1 if $self->{STORAGEHANDLE};
}

1;
__END__


=head1 DESCRIPTION

Data::Storage is module for a accessing various "data structures" stored inside
various "data containers". It sits on top of DBI and/or Tangram.


=head1 AUTHORS / COPYRIGHT

The Data::Storage module is Copyright (c) 2002 Andreas Motl.
All rights reserved.

You may distribute it under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.


=head1 ACKNOWLEDGEMENTS

Larry Wall for Perl, Tim Bunce for DBI, Jean-Louis Leroy for Tangram and Set::Object, 
Sam Vilain for Class::Tangram, 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 Handle the following errors/cases:

=head3 "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

=head3 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 Introduce some 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 some more handlers:
    - look at DBD::CSV, Text::CSV, XML::CSV, XML::Excel
  - Add some more locations/locators:
    - PerlDAV: http://www.webdav.org/perldav/
  - Move to t3, use InCASE


=head3 Links:

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