--- nfo/perl/libs/libdb.pm 2002/07/20 11:09:58 1.2 +++ nfo/perl/libs/libdb.pm 2003/04/08 23:07:57 1.10 @@ -1,7 +1,32 @@ ## -------------------------------------------------------------------------------- -## $Id: libdb.pm,v 1.2 2002/07/20 11:09:58 cvsjoko Exp $ +## $Id: libdb.pm,v 1.10 2003/04/08 23:07:57 joko Exp $ ## -------------------------------------------------------------------------------- ## $Log: libdb.pm,v $ +## Revision 1.10 2003/04/08 23:07:57 joko +## renamed core database helper functions +## moved 'hash2Sql' and 'quotesql' to shortcuts::db +## +## Revision 1.9 2003/02/09 04:47:58 joko +## + minor fix +## +## Revision 1.8 2002/12/12 02:48:58 joko +## + played with fixing disconnectTarget +## +## Revision 1.7 2002/12/01 22:13:17 joko +## + minor bugfix? +## +## Revision 1.6 2002/11/29 04:53:39 joko +## + hash2Sql now knows about SQL_SELECT +## +## Revision 1.5 2002/11/17 07:18:38 joko +## + small modification in hash2sql +## +## Revision 1.4 2002/10/16 22:36:42 joko +## + sub testDbServer +## +## Revision 1.3 2002/07/27 00:28:20 cvsjoko +## bugfixes +## ## Revision 1.2 2002/07/20 11:09:58 cvsjoko ## + bugfixes ## + dont' print sql-errors @@ -17,23 +42,22 @@ use strict; use warnings; -use libp; -use DBI; - require Exporter; our @ISA = qw( Exporter ); -our @EXPORT = qw( - testDsn hash2Sql - SQL_INSERT SQL_UPDATE +our @EXPORT_OK = qw( + testDsn connectTarget disconnectTarget sendSql dbNow - getDbNameByDsn sqlDbAction createSqlDb dropSqlDb - quotesql - testDsnForTables + dsn2dbname sqlDbAction createSqlDb dropSqlDb + testDsnForTables testDbServer ); -use constant SQL_INSERT => 10; -use constant SQL_UPDATE => 11; + +use Carp; +use DBI; +use Data::Dumper; + +use shortcuts::db qw( dsn2dbname ); my $dbmeta_ref_cache; @@ -48,46 +72,23 @@ } } -sub hash2Sql { - - my $table = shift; - my $hash = shift; - my $mode = shift; - my $crit = shift; - - my $sql; - if ($mode == SQL_INSERT) { - $sql = "INSERT INTO $table (#fields#) VALUES (#values#);"; - } - if ($mode == SQL_UPDATE) { - $sql = "UPDATE $table SET #fields-values# WHERE $crit;"; - } +sub testDbServer { + my $dsn = shift; + $dsn =~ s/database=(\w+)//; - my (@fields, @values); - foreach my $key (keys %{$hash}) { - push @fields, $key; - push @values, $hash->{$key}; - } - # quote each element - map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values; + #print "testDbServer: $dsn", "\n"; - my $fields = join(', ', @fields); - my $values = join(', ', @values); - my $fields_values = ''; - my $fc = 0; - foreach (@fields) { - $fields_values .= $_ . '=' . $values[$fc] . ', '; - $fc++; + my $result; + if ( my $dbh = DBI->connect($dsn, '', '', { + PrintError => 0, + } ) ) { + $dbh->disconnect(); + return 1; } - $fields_values = substr($fields_values, 0, -2); - - $sql =~ s/#fields#/$fields/; - $sql =~ s/#values#/$values/; - $sql =~ s/#fields-values#/$fields_values/; - - return $sql; } + + sub patch_dbmeta { my $dbmeta = shift; @@ -121,11 +122,16 @@ sub disconnectTarget { #my $dbmeta = shift; + #print "disc\n"; #croak "please supply a \"dbmeta\"-hash" if (!$dbmeta); #$dbmeta = patch_dbmeta($dbmeta); #$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect(); my $dbmeta = $dbmeta_ref_cache; - $dbmeta->{dbh} && $dbmeta->{dbh}->disconnect(); + #print Dumper($dbmeta); + #$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect(); + $dbmeta->{dbh}->disconnect(); + undef($dbmeta->{dbh}); + undef($dbmeta); undef($dbmeta_ref_cache); } @@ -141,9 +147,10 @@ return 0; } if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) { - if ($result->execute()) { + #if ($result->execute()) { + $result->execute(); return $result; - } + #} } } @@ -154,13 +161,6 @@ } -sub getDbNameByDsn { - my $dsn = shift; - $dsn =~ m/database=(.+?);/; - my $database_name = $1; - return $database_name; -} - sub sqlDbAction { my $dsn = shift; $dsn =~ s/database=.+?;//; @@ -173,8 +173,10 @@ my $bool_ok; if (connectTarget($dbmeta)) { sendSql($sql); - #print "state: ", $dbmeta->{dbh}->errstr, "\n"; - $bool_ok = ($dbmeta->{dbh} && $dbmeta->{dbh}->state && !$dbmeta->{dbh}->err); + #print "state: ", $dbmeta->{dbh}->state, "\n"; + #print "err ", $dbmeta->{dbh}->err, "\n"; + #$bool_ok = ($dbmeta->{dbh} && $dbmeta->{dbh}->state && !$dbmeta->{dbh}->err); + $bool_ok = ($dbmeta->{dbh} && !$dbmeta->{dbh}->err); disconnectTarget($dbmeta); } return $bool_ok; @@ -182,33 +184,28 @@ sub createSqlDb { my $dsn = shift; - my $dbname = getDbNameByDsn($dsn); + my $dbname = dsn2dbname($dsn); print " - creating rdbms-database $dbname ($dsn) ..."; my $sql; $sql = "CREATE DATABASE $dbname;"; if ( sqlDbAction($dsn, $sql) ) { - print "ok"; + print "ok", "\n"; + return 1; } else { - print "failed"; + print "failed", "\n"; + return 0; } - print "\n"; } sub dropSqlDb { my $dsn = shift; - my $dbname = getDbNameByDsn($dsn); + my $dbname = dsn2dbname($dsn); print " - dropping database $dbname", "\n"; my $sql; $sql = "DROP DATABASE $dbname;"; sqlDbAction($dsn, $sql); } -sub quotesql { - my $string = shift; - $string =~ s/'/\\'/g; - return $string; -} - sub testDsnForTables { my $dsn = shift; connectTarget($dsn); @@ -219,4 +216,4 @@ return 1 if ($bool_tablesHere); } -1; \ No newline at end of file +1;