perl/libs/libdb.pm

##    --------------------------------------------------------------------------------
##    $Id$
##    --------------------------------------------------------------------------------
##    $Log$
##
##    --------------------------------------------------------------------------------

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})) {
      $dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file});
      $dbmeta->{dbh}->{PrintError} = 0;
      $dbmeta->{connected} = 1;
      $dbmeta_ref_cache = $dbmeta;
    }
  }
}

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',
  };
  connectTarget($dbmeta);
  sendSql($sql);
  disconnectTarget($dbmeta);
}

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