perl/libs/libdb.pm

##    --------------------------------------------------------------------------------
##    $Id: libdb.pm,v 1.8 2002/12/12 02:48:58 joko Exp $
##    --------------------------------------------------------------------------------
##    $Log: libdb.pm,v $
##    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
##
##
##    --------------------------------------------------------------------------------

package libdb;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
                              testDsn hash2Sql 
                              SQL_INSERT SQL_UPDATE
                              connectTarget disconnectTarget sendSql
                              dbNow
                              getDbNameByDsn sqlDbAction createSqlDb dropSqlDb
                              quotesql
                              testDsnForTables testDbServer
                              );


use Carp;
use DBI;
use Data::Dumper;

use constant SQL_INSERT => 10;
use constant SQL_UPDATE => 11;
use constant SQL_SELECT => 12;

my $dbmeta_ref_cache;

sub testDsn {
  my $dsn = shift;
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    $dbh->disconnect();
    return 1;
  }
}

sub testDbServer {
  my $dsn = shift;
  $dsn =~ s/database=(\w+)//;
  
  #print "testDbServer: $dsn", "\n";
  
  my $result;
  if ( my $dbh = DBI->connect($dsn, '', '', {
                                                      PrintError => 0,
                                                      } ) ) {
    $dbh->disconnect();
    return 1;
  }
}


# TODO: handle usage of "$crit" in an abstract way somehow
sub hash2Sql {
  
  my $table = shift;
  my $hash = shift;
  my $mode = shift;
  my $crit = shift;
  
  my $sql;
  $mode = SQL_SELECT if ($mode eq 'SQL_SELECT' || $mode eq 'SELECT');
  $mode = SQL_INSERT if ($mode eq 'SQL_INSERT' || $mode eq 'INSERT');
  $mode = SQL_UPDATE if ($mode eq 'SQL_UPDATE' || $mode eq 'UPDATE');

  if ($mode == SQL_SELECT) {
    $sql = "SELECT #fields# FROM $table WHERE $crit";
  } elsif ($mode == SQL_INSERT) {
    $sql = "INSERT INTO $table (#fields#) VALUES (#values#)";
  } elsif ($mode == SQL_UPDATE) {
    $sql = "UPDATE $table SET #fields-values# WHERE $crit";
  }
  
  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++;
  }
  $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;

  if ($dbmeta =~ m/^dbi:/) {
    $dbmeta = {
      dsn => $dbmeta,
      trace_level => 0,
      trace_file => undef,
    };
  }
  
  return $dbmeta;
  
}

sub connectTarget {
  my $dbmeta = shift;
  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}, '', '', { 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;
  #print Dumper($dbmeta);
  #$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
  $dbmeta->{dbh}->disconnect();
  undef($dbmeta->{dbh});
  undef($dbmeta);
  undef($dbmeta_ref_cache);
}

sub sendSql {
  my $sql = shift;
  my $dbmeta_ref = shift;
  if (!$dbmeta_ref) { 
    $dbmeta_ref = $dbmeta_ref_cache;
  }
  #print "sql: $sql", "\n";
  if (!$dbmeta_ref->{connected}) {
    print "not connected!", "\n";
    return 0;
  }
  if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) {
    #if ($result->execute()) {
      $result->execute();
      return $result;
    #}
  }
}

sub dbNow {
  #my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
  my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime);
  return $now_string;
}


sub getDbNameByDsn {
  my $dsn = shift;
  $dsn =~ m/database=(.+?);/;
  my $database_name = $1;
  return $database_name;
}

sub sqlDbAction {
  my $dsn = shift;
  $dsn =~ s/database=.+?;//;
  my $sql = shift;
  my $dbmeta = {
    dsn => $dsn,
    trace_level => 1,
    trace_file => 'dbitrace',
  };
  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 rdbms-database $dbname ($dsn) ...";
  my $sql;
  $sql = "CREATE DATABASE $dbname;";
  if ( sqlDbAction($dsn, $sql) ) {
    print "ok", "\n";
    return 1;
  } else {
    print "failed", "\n";
    return 0;
  }
}

sub dropSqlDb {
  my $dsn = shift;
  my $dbname = getDbNameByDsn($dsn);
  print "  - dropping database $dbname", "\n";
  my $sql;
  $sql = "DROP DATABASE $dbname;";
  sqlDbAction($dsn, $sql);
}

sub quotesql {
  my $string = shift;
  if ($string) {
    $string =~ s/'/\\'/g;
  }
  return $string;
}

sub testDsnForTables {
  my $dsn = shift;
  connectTarget($dsn);
  my $result = sendSql('SHOW TABLES;');
  my $bool_tablesHere = $result->fetchrow_hashref();
  $result->finish();
  disconnectTarget($dsn);
  return 1 if ($bool_tablesHere);
}

1;
1	cvsjoko	1.1	## --------------------------------------------------------------------------------
2	joko	1.9	## $Id: libdb.pm,v 1.8 2002/12/12 02:48:58 joko Exp $
3	cvsjoko	1.1	## --------------------------------------------------------------------------------
4	cvsjoko	1.2	## $Log: libdb.pm,v $
5	joko	1.9	## Revision 1.8 2002/12/12 02:48:58 joko
6			## + played with fixing disconnectTarget
7			##
8	joko	1.8	## Revision 1.7 2002/12/01 22:13:17 joko
9			## + minor bugfix?
10			##
11	joko	1.7	## Revision 1.6 2002/11/29 04:53:39 joko
12			## + hash2Sql now knows about SQL_SELECT
13			##
14	joko	1.6	## Revision 1.5 2002/11/17 07:18:38 joko
15			## + small modification in hash2sql
16			##
17	joko	1.5	## Revision 1.4 2002/10/16 22:36:42 joko
18			## + sub testDbServer
19			##
20	joko	1.4	## Revision 1.3 2002/07/27 00:28:20 cvsjoko
21			## bugfixes
22			##
23	cvsjoko	1.3	## Revision 1.2 2002/07/20 11:09:58 cvsjoko
24			## + bugfixes
25			## + dont' print sql-errors
26			##
27	cvsjoko	1.2	## Revision 1.1 2002/07/19 18:14:03 cvsjoko
28			## no message
29			##
30	cvsjoko	1.1	##
31			## --------------------------------------------------------------------------------
32
33			package libdb;
34
35			use strict;
36			use warnings;
37
38			require Exporter;
39			our @ISA = qw( Exporter );
40	joko	1.6	our @EXPORT_OK = qw(
41	cvsjoko	1.1	testDsn hash2Sql
42			SQL_INSERT SQL_UPDATE
43			connectTarget disconnectTarget sendSql
44			dbNow
45			getDbNameByDsn sqlDbAction createSqlDb dropSqlDb
46			quotesql
47	joko	1.4	testDsnForTables testDbServer
48	cvsjoko	1.1	);
49
50	joko	1.6
51	joko	1.9	use Carp;
52	joko	1.6	use DBI;
53	joko	1.8	use Data::Dumper;
54	joko	1.6
55	cvsjoko	1.1	use constant SQL_INSERT => 10;
56			use constant SQL_UPDATE => 11;
57	joko	1.6	use constant SQL_SELECT => 12;
58	cvsjoko	1.1
59			my $dbmeta_ref_cache;
60
61			sub testDsn {
62			my $dsn = shift;
63			my $result;
64			if ( my $dbh = DBI->connect($dsn, '', '', {
65			PrintError => 0,
66			} ) ) {
67			$dbh->disconnect();
68			return 1;
69			}
70			}
71
72	joko	1.4	sub testDbServer {
73			my $dsn = shift;
74			$dsn =~ s/database=(\w+)//;
75
76			#print "testDbServer: $dsn", "\n";
77
78			my $result;
79			if ( my $dbh = DBI->connect($dsn, '', '', {
80			PrintError => 0,
81			} ) ) {
82			$dbh->disconnect();
83			return 1;
84			}
85			}
86
87	joko	1.6
88			# TODO: handle usage of "$crit" in an abstract way somehow
89	cvsjoko	1.1	sub hash2Sql {
90
91			my $table = shift;
92			my $hash = shift;
93			my $mode = shift;
94			my $crit = shift;
95
96			my $sql;
97	joko	1.6	$mode = SQL_SELECT if ($mode eq 'SQL_SELECT' \|\| $mode eq 'SELECT');
98			$mode = SQL_INSERT if ($mode eq 'SQL_INSERT' \|\| $mode eq 'INSERT');
99			$mode = SQL_UPDATE if ($mode eq 'SQL_UPDATE' \|\| $mode eq 'UPDATE');
100
101			if ($mode == SQL_SELECT) {
102			$sql = "SELECT #fields# FROM $table WHERE $crit";
103			} elsif ($mode == SQL_INSERT) {
104			$sql = "INSERT INTO $table (#fields#) VALUES (#values#)";
105			} elsif ($mode == SQL_UPDATE) {
106			$sql = "UPDATE $table SET #fields-values# WHERE $crit";
107	cvsjoko	1.1	}
108
109			my (@fields, @values);
110			foreach my $key (keys %{$hash}) {
111			push @fields, $key;
112			push @values, $hash->{$key};
113			}
114			# quote each element
115			map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values;
116
117			my $fields = join(', ', @fields);
118			my $values = join(', ', @values);
119			my $fields_values = '';
120			my $fc = 0;
121			foreach (@fields) {
122			$fields_values .= $_ . '=' . $values[$fc] . ', ';
123			$fc++;
124			}
125			$fields_values = substr($fields_values, 0, -2);
126
127			$sql =~ s/#fields#/$fields/;
128			$sql =~ s/#values#/$values/;
129			$sql =~ s/#fields-values#/$fields_values/;
130
131			return $sql;
132			}
133
134			sub patch_dbmeta {
135
136			my $dbmeta = shift;
137
138			if ($dbmeta =~ m/^dbi:/) {
139			$dbmeta = {
140			dsn => $dbmeta,
141			trace_level => 0,
142			trace_file => undef,
143			};
144			}
145
146			return $dbmeta;
147
148			}
149
150			sub connectTarget {
151			my $dbmeta = shift;
152			croak "please supply a dsn or a \"dbmeta\"-hash" if (!$dbmeta);
153			$dbmeta = patch_dbmeta($dbmeta);
154			if (!$dbmeta->{connected}) {
155	cvsjoko	1.2	if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn}, '', '', { PrintError => 0 } )) {
156	cvsjoko	1.1	$dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file});
157			$dbmeta->{dbh}->{PrintError} = 0;
158			$dbmeta->{connected} = 1;
159			$dbmeta_ref_cache = $dbmeta;
160	cvsjoko	1.2	return 1;
161	cvsjoko	1.1	}
162			}
163			}
164
165			sub disconnectTarget {
166			#my $dbmeta = shift;
167	joko	1.8	#print "disc\n";
168	cvsjoko	1.1	#croak "please supply a \"dbmeta\"-hash" if (!$dbmeta);
169			#$dbmeta = patch_dbmeta($dbmeta);
170			#$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
171			my $dbmeta = $dbmeta_ref_cache;
172	joko	1.8	#print Dumper($dbmeta);
173			#$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
174			$dbmeta->{dbh}->disconnect();
175	joko	1.7	undef($dbmeta->{dbh});
176	joko	1.8	undef($dbmeta);
177			undef($dbmeta_ref_cache);
178	cvsjoko	1.1	}
179
180			sub sendSql {
181			my $sql = shift;
182			my $dbmeta_ref = shift;
183			if (!$dbmeta_ref) {
184			$dbmeta_ref = $dbmeta_ref_cache;
185			}
186			#print "sql: $sql", "\n";
187			if (!$dbmeta_ref->{connected}) {
188			print "not connected!", "\n";
189			return 0;
190			}
191			if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) {
192	joko	1.4	#if ($result->execute()) {
193			$result->execute();
194	cvsjoko	1.1	return $result;
195	joko	1.4	#}
196	cvsjoko	1.1	}
197			}
198
199			sub dbNow {
200			#my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
201			my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime);
202			return $now_string;
203			}
204
205
206			sub getDbNameByDsn {
207			my $dsn = shift;
208			$dsn =~ m/database=(.+?);/;
209			my $database_name = $1;
210			return $database_name;
211			}
212
213			sub sqlDbAction {
214			my $dsn = shift;
215			$dsn =~ s/database=.+?;//;
216			my $sql = shift;
217			my $dbmeta = {
218			dsn => $dsn,
219			trace_level => 1,
220			trace_file => 'dbitrace',
221			};
222	cvsjoko	1.2	my $bool_ok;
223			if (connectTarget($dbmeta)) {
224			sendSql($sql);
225	cvsjoko	1.3	#print "state: ", $dbmeta->{dbh}->state, "\n";
226			#print "err ", $dbmeta->{dbh}->err, "\n";
227			#$bool_ok = ($dbmeta->{dbh} && $dbmeta->{dbh}->state && !$dbmeta->{dbh}->err);
228			$bool_ok = ($dbmeta->{dbh} && !$dbmeta->{dbh}->err);
229	cvsjoko	1.2	disconnectTarget($dbmeta);
230			}
231			return $bool_ok;
232	cvsjoko	1.1	}
233
234			sub createSqlDb {
235			my $dsn = shift;
236			my $dbname = getDbNameByDsn($dsn);
237	cvsjoko	1.2	print " - creating rdbms-database $dbname ($dsn) ...";
238	cvsjoko	1.1	my $sql;
239			$sql = "CREATE DATABASE $dbname;";
240	cvsjoko	1.2	if ( sqlDbAction($dsn, $sql) ) {
241	cvsjoko	1.3	print "ok", "\n";
242			return 1;
243	cvsjoko	1.2	} else {
244	cvsjoko	1.3	print "failed", "\n";
245			return 0;
246	cvsjoko	1.2	}
247	cvsjoko	1.1	}
248	cvsjoko	1.2
249	cvsjoko	1.1	sub dropSqlDb {
250			my $dsn = shift;
251			my $dbname = getDbNameByDsn($dsn);
252			print " - dropping database $dbname", "\n";
253			my $sql;
254			$sql = "DROP DATABASE $dbname;";
255			sqlDbAction($dsn, $sql);
256			}
257
258			sub quotesql {
259			my $string = shift;
260	joko	1.4	if ($string) {
261			$string =~ s/'/\\'/g;
262			}
263	cvsjoko	1.1	return $string;
264			}
265
266			sub testDsnForTables {
267			my $dsn = shift;
268			connectTarget($dsn);
269			my $result = sendSql('SHOW TABLES;');
270			my $bool_tablesHere = $result->fetchrow_hashref();
271			$result->finish();
272			disconnectTarget($dsn);
273			return 1 if ($bool_tablesHere);
274			}
275
276	cvsjoko	1.3	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26