perl/libs/libdb.pm

##    --------------------------------------------------------------------------------
##    $Id: libdb.pm,v 1.1 2002/07/19 18:14:03 cvsjoko Exp $
##    --------------------------------------------------------------------------------
##    $Log: libdb.pm,v $
##    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
                              );

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 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;";
  }
  
  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()) {
      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}->errstr, "\n";
    $bool_ok = ($dbmeta->{dbh} && $dbmeta->{dbh}->state && !$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";
  } else {
    print "failed";
  }
  print "\n";
}

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