perl/libs/libdb.pm

##    --------------------------------------------------------------------------------
##    $Id: libdb.pm,v 1.3 2002/07/27 00:28:20 cvsjoko Exp $
##    --------------------------------------------------------------------------------
##    $Log: libdb.pm,v $
##    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;

use libp;
use DBI;

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

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

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;
  }
}

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