--- nfo/perl/libs/Data/Storage/Handler/DBI.pm 2002/10/25 11:43:27 1.2 +++ nfo/perl/libs/Data/Storage/Handler/DBI.pm 2003/04/08 23:06:45 1.13 @@ -1,8 +1,45 @@ ################################# # -# $Id: DBI.pm,v 1.2 2002/10/25 11:43:27 joko Exp $ +# $Id: DBI.pm,v 1.13 2003/04/08 23:06:45 joko Exp $ # # $Log: DBI.pm,v $ +# Revision 1.13 2003/04/08 23:06:45 joko +# renamed core database helper functions +# +# Revision 1.12 2003/01/30 22:28:21 joko +# + implemented new concrete methods +# +# Revision 1.11 2002/12/19 16:31:05 joko +# + sub dropDb +# + sub rebuildDb +# +# Revision 1.10 2002/12/15 02:02:22 joko +# + fixed logging-message +# +# Revision 1.9 2002/12/05 07:58:20 joko +# + now using Tie::SecureHash as a base for the COREHANDLE +# + former public COREHANDLE becomes private _COREHANDLE now +# +# Revision 1.8 2002/12/01 22:20:43 joko +# + sub createDb (from Storage.pm) +# +# Revision 1.7 2002/12/01 07:09:09 joko +# + sub getListFiltered (dummy redirecting to getListUnfiltered) +# +# Revision 1.6 2002/12/01 04:46:01 joko +# + sub eraseAll +# +# Revision 1.5 2002/11/29 05:00:26 joko +# + sub getListUnfiltered +# + sub sendQuery +# +# Revision 1.4 2002/11/17 08:46:42 jonen +# + wrapped eval around DBI->connect to prevent deaths +# +# Revision 1.3 2002/11/17 06:34:39 joko +# + locator metadata can now be reached via ->{locator} +# - sub hash2sql now taken from libdb +# # Revision 1.2 2002/10/25 11:43:27 joko # + enhanced robustness # + more logging for debug-levels @@ -20,22 +57,32 @@ use base ("Data::Storage::Handler::Abstract"); + use DBI; +use Data::Dumper; +use shortcuts::db qw( hash2sql dsn2dbname ); +use Data::Storage::Result::DBI; + # get logger instance my $logger = Log::Dispatch::Config->instance; -our $metainfo = { - 'disconnectMethod' => 'disconnect', -}; +sub getMetaInfo { + my $self = shift; + $logger->debug( __PACKAGE__ . "->getMetaInfo()" ); + return { + 'disconnectMethod' => 'disconnect', + }; +} sub connect { my $self = shift; # create handle - if ( my $dsn = $self->{dbi}->{dsn} ) { + if ( my $dsn = $self->{locator}->{dbi}->{dsn} ) { + #if ( my $dsn = $self->{locator}->{dsn} ) { $logger->debug( __PACKAGE__ . "->connect( dsn $dsn )" ); # HACK: @@ -45,21 +92,20 @@ #use Data::Dumper; print Dumper($self->{dbi}); - $self->{COREHANDLE} = DBI->connect( - $dsn, '', '', { - RaiseError => $self->{dbi}->{RaiseError}, - #RaiseError => 1, - PrintError => $self->{dbi}->{PrintError}, - HandleError => $self->{dbi}->{HandleError}, + eval { + $self->{_COREHANDLE} = DBI->connect( $dsn, '', '', $self->{locator}->{dbi} ); + if (!$self->{_COREHANDLE}) { + $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr ); + return; } - ); - if (!$self->{COREHANDLE}) { - $logger->warning( __PACKAGE__ . "->connect failed: " . DBI::errstr ); - return; - } + }; + $logger->warning( __PACKAGE__ . "->connect failed: " . $@ ) if $@; + } $self->configureCOREHANDLE(); - + + $self->{locator}->{status}->{connected} = 1; + return 1; } @@ -68,20 +114,22 @@ my $self = shift; - $logger->debug( __PACKAGE__ . "->_configureCOREHANDLE" ); + $logger->debug( __PACKAGE__ . "->configureCOREHANDLE" ); + + return if !$self->{_COREHANDLE}; - # apply configured modifications - if (exists $self->{dbi}->{trace_level} && exists $self->{dbi}->{trace_file}) { - $self->{COREHANDLE}->trace($self->{dbi}->{trace_level}, $self->{dbi}->{trace_file}); + # apply configured modifications to DBI-handle + if (exists $self->{locator}->{dbi}->{trace_level} && exists $self->{locator}->{dbi}->{trace_file}) { + $self->{_COREHANDLE}->trace($self->{locator}->{dbi}->{trace_level}, $self->{locator}->{dbi}->{trace_file}); } - if (exists $self->{dbi}->{RaiseError}) { - $self->{COREHANDLE}->{RaiseError} = $self->{dbi}->{RaiseError}; + if (exists $self->{locator}->{dbi}->{RaiseError}) { + $self->{_COREHANDLE}->{RaiseError} = $self->{locator}->{dbi}->{RaiseError}; } - if (exists $self->{dbi}->{PrintError}) { - $self->{COREHANDLE}->{PrintError} = $self->{dbi}->{PrintError}; + if (exists $self->{locator}->{dbi}->{PrintError}) { + $self->{_COREHANDLE}->{PrintError} = $self->{locator}->{dbi}->{PrintError}; } - if (exists $self->{dbi}->{HandleError}) { - $self->{COREHANDLE}->{HandleError} = $self->{dbi}->{HandleError}; + if (exists $self->{locator}->{dbi}->{HandleError}) { + $self->{_COREHANDLE}->{HandleError} = $self->{locator}->{dbi}->{HandleError}; } } @@ -92,16 +140,18 @@ # two-level handling for implicit connect: # if there's no corehandle ... - if (!$self->{COREHANDLE}) { + if (!$self->{_COREHANDLE}) { # ... try to connect, but ... $self->connect(); # ... if this still fails, there's something wrong probably, so we won't continue - if (!$self->{COREHANDLE}) { + if (!$self->{_COREHANDLE}) { return; } } - my $sth = $self->{COREHANDLE}->prepare($sql); + #print "prepare sql: $sql\n"; + + my $sth = $self->{_COREHANDLE}->prepare($sql); $sth->execute(); return $sth; } @@ -109,99 +159,191 @@ sub sendCommand { my $self = shift; my $command = shift; + # TODO: when tracing: yes, do actually log this #$logger->debug( __PACKAGE__ . "->sendCommand( command $command )" ); my $cmdHandle = $self->_sendSql($command); my $result = Data::Storage::Result::DBI->new( RESULTHANDLE => $cmdHandle ); return $result; } -sub quoteSql { +sub getChildNodes { my $self = shift; - my $string = shift; - if ($string) { - $string =~ s/'/\\'/g; + my @nodes; + $logger->debug( __PACKAGE__ . "->getChildNodes()" ); + my $locator = $self->{locator}; + #print Dumper($locator); exit; + if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) { + my $dbname = dsn2dbname($self->{locator}->{dbi}->{dsn}); + my $key = "Tables_in_$dbname"; + while ( my $row = $result->getNextEntry() ) { + push @nodes, $row->{$key}; + } } - return $string; + return \@nodes; } -sub hash2Sql { - +sub getListUnfiltered { my $self = shift; - - my $table = shift; - my $hash = shift; - my $mode = shift; - my $crit = shift; - - my $sql; - if ($mode eq 'SQL_INSERT') { - $sql = "INSERT INTO $table (#fields#) VALUES (#values#);"; - } - if ($mode eq 'SQL_UPDATE') { - $sql = "UPDATE $table SET #fields-values# WHERE $crit;"; + my $nodename = shift; + my @list; + $logger->debug( __PACKAGE__ . "->getListUnfiltered( nodename => '" . $nodename . "' )" ); + # get list of rows from rdbms by table name + my $result = $self->sendCommand("SELECT * FROM $nodename"); + while ( my $row = $result->getNextEntry() ) { + push @list, $row; } - - my (@fields, @values); - foreach my $key (keys %{$hash}) { - push @fields, $key; - push @values, $hash->{$key}; - } - # quote each element - map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values; - - my $fields = join(', ', @fields); - my $values = join(', ', @values); - my $fields_values = ''; - my $fc = 0; - foreach (@fields) { - $fields_values .= $_ . '=' . $values[$fc] . ', '; - $fc++; + return \@list; +} + +sub sendQuery { + my $self = shift; + my $query = shift; + + $logger->debug( __PACKAGE__ . "->sendQuery" ); + + #my $sql = "SELECT cs FROM $self->{metainfo}->{$descent}->{node} WHERE $self->{metainfo}->{$descent}->{IdentProvider}->{arg}='$self->{entry}->{source}->{ident}';"; + #my $result = $self->{metainfo}->{$descent}->{storage}->sendCommand($sql); + my @crits; + foreach (@{$query->{criterias}}) { + my $op = ''; + $op = '=' if lc $_->{op} eq 'eq'; + push @crits, "$_->{key}$op'$_->{val}'"; } - $fields_values = substr($fields_values, 0, -2); - - $sql =~ s/#fields#/$fields/; - $sql =~ s/#values#/$values/; - $sql =~ s/#fields-values#/$fields_values/; - - return $sql; + my $subnodes = {}; + map { $subnodes->{$_}++ } @{$query->{subnodes}}; + # HACK: this is hardcoded ;( expand possibilities! + my $crit = join(' AND ', @crits); + my $sql = hash2sql($query->{node}, $subnodes, 'SELECT', $crit); + return $self->sendCommand($sql); } +sub eraseAll { + my $self = shift; + my $classname = shift; + $logger->debug( __PACKAGE__ . "->eraseAll" ); + my $sql = "DELETE FROM $classname"; + $self->sendCommand($sql); +} -sub getChildNodes { +# TODO: actually implement the filtering functionality using $this->sendQuery +sub getListFiltered { + my $self = shift; + my $nodename = shift; + return $self->getListUnfiltered($nodename); +} +# TODO: do this via a parametrized "$self->connect()" +sub createDb { + my $self = shift; - my @nodes; + + # get dsn from Data::Storage::Locator instance + my $dsn = $self->{locator}->{dbi}->{dsn}; - if (my $result = $self->sendCommand( 'SHOW TABLES;' ) ) { - while ( my $row = $result->_getNextEntry() ) { - push @nodes, $row; + $logger->debug( __PACKAGE__ . "->createDb( dsn $dsn )" ); + + # remove database setting from dsn-string + $dsn =~ s/database=(.+?);//; + + # remember extracted database name to know what actually to create right now + my $database_name = $1; + + # flag to indicate goodness + my $ok; + + # connect to database server - don't select/use any specific database + #if ( my $dbh = DBI->connect($dsn, '', '', { PrintError => 0 } ) ) { + if ( my $dbh = DBI->connect($dsn, '', '', $self->{locator}->{dbi} ) ) { + + if ($database_name) { + if ($dbh->do("CREATE DATABASE $database_name")) { + $ok = 1; + } } + + $dbh->disconnect(); + } - return \@nodes; + return $ok; + +} +sub getCOREHANDLE2 { + my $self = shift; + return $self->{_COREHANDLE}; } +sub dropDb { + my $self = shift; + my $dsn = $self->{locator}->{dbi}->{dsn}; + $logger->debug( __PACKAGE__ . "->dropDb( dsn $dsn )" ); + $dsn =~ s/database=(.+?);//; + my $database_name = $1; -package Data::Storage::Result::DBI; + my $ok; + + if ( my $dbh = DBI->connect($dsn, '', '', { + PrintError => 0, + } ) ) { + if ($database_name) { + if ($dbh->do("DROP DATABASE $database_name;")) { + $ok = 1; + } + } -use strict; -use warnings; + $dbh->disconnect(); -use base ("Data::Storage::Result"); + } + + return $ok; +} -sub DESTROY { +sub rebuildDb { my $self = shift; - #$logger->debug( __PACKAGE__ . "->" . "DESTROY" ); - $self->{RESULTHANDLE} && $self->{RESULTHANDLE}->finish(); + $logger->info( __PACKAGE__ . "->rebuildDb()" ); + my @results; + + # sum up results (bool (0/1)) in array + #push @results, $self->retreatSchema(); + push @results, $self->dropDb(); + push @results, $self->createDb(); + #push @results, $self->deploySchema(); + + # scan array for "bad ones" + my $res = 1; + map { + $res = 0 if (!$_); + } @results; + + return $res; } -sub _getNextEntry { +sub testAvailability { my $self = shift; - $self->{RESULTHANDLE} && return $self->{RESULTHANDLE}->fetchrow_hashref; + my $status = $self->testDsn(); + $self->{locator}->{status}->{available} = $status; + return $status; } +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 ); + } +} -1; \ No newline at end of file +1; +__END__