--- nfo/perl/libs/libdb.pm 2002/07/19 18:14:03 1.1 +++ nfo/perl/libs/libdb.pm 2003/04/08 23:07:57 1.10 @@ -1,7 +1,36 @@ ## -------------------------------------------------------------------------------- -## $Id: libdb.pm,v 1.1 2002/07/19 18:14:03 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 +## ## Revision 1.1 2002/07/19 18:14:03 cvsjoko ## no message ## @@ -13,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; @@ -44,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; @@ -105,22 +110,28 @@ croak "please supply a dsn or a \"dbmeta\"-hash" if (!$dbmeta); $dbmeta = patch_dbmeta($dbmeta); if (!$dbmeta->{connected}) { - if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn})) { + if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn}, '', '', { PrintError => 0 } )) { $dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file}); $dbmeta->{dbh}->{PrintError} = 0; $dbmeta->{connected} = 1; $dbmeta_ref_cache = $dbmeta; + return 1; } } } 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); } @@ -136,9 +147,10 @@ return 0; } if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) { - if ($result->execute()) { + #if ($result->execute()) { + $result->execute(); return $result; - } + #} } } @@ -149,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=.+?;//; @@ -165,34 +170,42 @@ trace_level => 1, trace_file => 'dbitrace', }; - connectTarget($dbmeta); - sendSql($sql); - disconnectTarget($dbmeta); + my $bool_ok; + if (connectTarget($dbmeta)) { + sendSql($sql); + #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; } sub createSqlDb { my $dsn = shift; - my $dbname = getDbNameByDsn($dsn); - print " - creating database $dbname", "\n"; + my $dbname = dsn2dbname($dsn); + print " - creating rdbms-database $dbname ($dsn) ..."; my $sql; $sql = "CREATE DATABASE $dbname;"; - sqlDbAction($dsn, $sql); + if ( sqlDbAction($dsn, $sql) ) { + print "ok", "\n"; + return 1; + } else { + print "failed", "\n"; + return 0; + } } + 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); @@ -203,4 +216,4 @@ return 1 if ($bool_tablesHere); } -1; \ No newline at end of file +1;