--- nfo/perl/libs/Data/Storage.pm 2002/10/10 03:43:12 1.1 +++ nfo/perl/libs/Data/Storage.pm 2002/10/25 11:40:37 1.3 @@ -1,22 +1,34 @@ ################################# # -# $Id: Storage.pm,v 1.1 2002/10/10 03:43:12 cvsjoko Exp $ +# $Id: Storage.pm,v 1.3 2002/10/25 11:40:37 joko Exp $ # # $Log: Storage.pm,v $ +# 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 + package Data::Storage; use strict; use warnings; use Data::Storage::Locator; -use Data::Storage::Handler::DBI; -use Data::Storage::Handler::Tangram; # get logger instance my $logger = Log::Dispatch::Config->instance; @@ -37,6 +49,13 @@ 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; @@ -46,8 +65,19 @@ my $method = $AUTOLOAD; $method =~ s/^.*:://; - #$logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->" . $method . "(@_)" . " (AUTOLOAD)" ); + # advanced logging of AUTOLOAD calls + 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 ); + # filtering AUTOLOAD calls if ($self->_filter_AUTOLOAD($method)) { $self->_accessStorage(); $self->{STORAGEHANDLE}->$method(@_); @@ -79,7 +109,7 @@ sub _accessStorage { my $self = shift; # TODO: to some tracelevel! - #$logger->debug( __PACKAGE__ . "[$self->{type}]" . "->_accessStorage()" ); + $logger->debug( __PACKAGE__ . "[$self->{locator}->{type}]" . "->_accessStorage()" ); if (!$self->{STORAGEHANDLE}) { $self->_createStorageHandle(); } @@ -96,15 +126,20 @@ # propagate args to handler # needs some more thoughts! (not only "dbi" to Tangram, when (in future) db is not more the common case) if ($type eq 'DBI') { + use Data::Storage::Handler::DBI; #my @args = %{$self->{locator}->{dbi}}; my @args = %{$self->{locator}}; + # create new storage handle $self->{STORAGEHANDLE} = $pkg->new( @args ); } if ($type eq 'Tangram') { + use Data::Storage::Handler::Tangram; #$self->{STORAGEHANDLE} = $pkg->new( dsn => $self->{locator}->{dbi}->{dsn} ); #my @args = %{$self->{locator}->{dbi}}; my @args = %{$self->{locator}}; + # create new storage handle $self->{STORAGEHANDLE} = $pkg->new( @args ); + #$self->{STORAGEHANDLE_UNDERLYING} = $self->{STORAGEHANDLE}->getUnderlyingStorage(); #$self->{STORAGEHANDLE_UNDERLYING}->_configureCOREHANDLE(); } @@ -116,7 +151,7 @@ my $self = shift; my $name = shift; my $package = shift; - my $logger = shift; + my $logger1 = shift; my $objectCreator = shift; #$logger->add( Log::Dispatch::Tangram->new( name => $name, @@ -143,7 +178,7 @@ my $self = shift; my $name = shift; - my $logger = shift; + #my $logger = shift; $logger->remove($name); @@ -167,8 +202,64 @@ $dbh->disconnect(); return 1; } else { - $logger->error( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . DBI::errstr ); + $logger->error( __PACKAGE__ . "[$self->{locator}->{type}]" . "->testDsn(): " . "DBI-error: " . $DBI::errstr ); } } +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; \ No newline at end of file