perl/libs/libdb.pm

##    --------------------------------------------------------------------------------
##    $Id: libdb.pm,v 1.9 2003/02/09 04:47:58 joko Exp $
##    --------------------------------------------------------------------------------
##    $Log: libdb.pm,v $
##    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
##
##
##    --------------------------------------------------------------------------------

package libdb;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
                              testDsn 
                              connectTarget disconnectTarget sendSql
                              dbNow
                              dsn2dbname sqlDbAction createSqlDb dropSqlDb
                              testDsnForTables testDbServer
                              );


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

use shortcuts::db qw( dsn2dbname );

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 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 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 = dsn2dbname($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 = dsn2dbname($dsn);
  print "  - dropping database $dbname", "\n";
  my $sql;
  $sql = "DROP DATABASE $dbname;";
  sqlDbAction($dsn, $sql);
}

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.10	## $Id: libdb.pm,v 1.9 2003/02/09 04:47:58 joko Exp $
3	cvsjoko	1.1	## --------------------------------------------------------------------------------
4	cvsjoko	1.2	## $Log: libdb.pm,v $
5	joko	1.10	## Revision 1.9 2003/02/09 04:47:58 joko
6			## + minor fix
7			##
8	joko	1.9	## Revision 1.8 2002/12/12 02:48:58 joko
9			## + played with fixing disconnectTarget
10			##
11	joko	1.8	## Revision 1.7 2002/12/01 22:13:17 joko
12			## + minor bugfix?
13			##
14	joko	1.7	## Revision 1.6 2002/11/29 04:53:39 joko
15			## + hash2Sql now knows about SQL_SELECT
16			##
17	joko	1.6	## Revision 1.5 2002/11/17 07:18:38 joko
18			## + small modification in hash2sql
19			##
20	joko	1.5	## Revision 1.4 2002/10/16 22:36:42 joko
21			## + sub testDbServer
22			##
23	joko	1.4	## Revision 1.3 2002/07/27 00:28:20 cvsjoko
24			## bugfixes
25			##
26	cvsjoko	1.3	## Revision 1.2 2002/07/20 11:09:58 cvsjoko
27			## + bugfixes
28			## + dont' print sql-errors
29			##
30	cvsjoko	1.2	## Revision 1.1 2002/07/19 18:14:03 cvsjoko
31			## no message
32			##
33	cvsjoko	1.1	##
34			## --------------------------------------------------------------------------------
35
36			package libdb;
37
38			use strict;
39			use warnings;
40
41			require Exporter;
42			our @ISA = qw( Exporter );
43	joko	1.6	our @EXPORT_OK = qw(
44	joko	1.10	testDsn
45	cvsjoko	1.1	connectTarget disconnectTarget sendSql
46			dbNow
47	joko	1.10	dsn2dbname sqlDbAction createSqlDb dropSqlDb
48	joko	1.4	testDsnForTables testDbServer
49	cvsjoko	1.1	);
50
51	joko	1.6
52	joko	1.9	use Carp;
53	joko	1.6	use DBI;
54	joko	1.8	use Data::Dumper;
55	joko	1.6
56	joko	1.10	use shortcuts::db qw( dsn2dbname );
57	cvsjoko	1.1
58			my $dbmeta_ref_cache;
59
60			sub testDsn {
61			my $dsn = shift;
62			my $result;
63			if ( my $dbh = DBI->connect($dsn, '', '', {
64			PrintError => 0,
65			} ) ) {
66			$dbh->disconnect();
67			return 1;
68			}
69			}
70
71	joko	1.4	sub testDbServer {
72			my $dsn = shift;
73			$dsn =~ s/database=(\w+)//;
74
75			#print "testDbServer: $dsn", "\n";
76
77			my $result;
78			if ( my $dbh = DBI->connect($dsn, '', '', {
79			PrintError => 0,
80			} ) ) {
81			$dbh->disconnect();
82			return 1;
83			}
84			}
85
86	joko	1.6
87	cvsjoko	1.1
88			sub patch_dbmeta {
89
90			my $dbmeta = shift;
91
92			if ($dbmeta =~ m/^dbi:/) {
93			$dbmeta = {
94			dsn => $dbmeta,
95			trace_level => 0,
96			trace_file => undef,
97			};
98			}
99
100			return $dbmeta;
101
102			}
103
104			sub connectTarget {
105			my $dbmeta = shift;
106			croak "please supply a dsn or a \"dbmeta\"-hash" if (!$dbmeta);
107			$dbmeta = patch_dbmeta($dbmeta);
108			if (!$dbmeta->{connected}) {
109	cvsjoko	1.2	if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn}, '', '', { PrintError => 0 } )) {
110	cvsjoko	1.1	$dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file});
111			$dbmeta->{dbh}->{PrintError} = 0;
112			$dbmeta->{connected} = 1;
113			$dbmeta_ref_cache = $dbmeta;
114	cvsjoko	1.2	return 1;
115	cvsjoko	1.1	}
116			}
117			}
118
119			sub disconnectTarget {
120			#my $dbmeta = shift;
121	joko	1.8	#print "disc\n";
122	cvsjoko	1.1	#croak "please supply a \"dbmeta\"-hash" if (!$dbmeta);
123			#$dbmeta = patch_dbmeta($dbmeta);
124			#$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
125			my $dbmeta = $dbmeta_ref_cache;
126	joko	1.8	#print Dumper($dbmeta);
127			#$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
128			$dbmeta->{dbh}->disconnect();
129	joko	1.7	undef($dbmeta->{dbh});
130	joko	1.8	undef($dbmeta);
131			undef($dbmeta_ref_cache);
132	cvsjoko	1.1	}
133
134			sub sendSql {
135			my $sql = shift;
136			my $dbmeta_ref = shift;
137			if (!$dbmeta_ref) {
138			$dbmeta_ref = $dbmeta_ref_cache;
139			}
140			#print "sql: $sql", "\n";
141			if (!$dbmeta_ref->{connected}) {
142			print "not connected!", "\n";
143			return 0;
144			}
145			if (my $result = $dbmeta_ref->{dbh}->prepare($sql)) {
146	joko	1.4	#if ($result->execute()) {
147			$result->execute();
148	cvsjoko	1.1	return $result;
149	joko	1.4	#}
150	cvsjoko	1.1	}
151			}
152
153			sub dbNow {
154			#my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
155			my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime);
156			return $now_string;
157			}
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	cvsjoko	1.3	#print "state: ", $dbmeta->{dbh}->state, "\n";
173			#print "err ", $dbmeta->{dbh}->err, "\n";
174			#$bool_ok = ($dbmeta->{dbh} && $dbmeta->{dbh}->state && !$dbmeta->{dbh}->err);
175			$bool_ok = ($dbmeta->{dbh} && !$dbmeta->{dbh}->err);
176	cvsjoko	1.2	disconnectTarget($dbmeta);
177			}
178			return $bool_ok;
179	cvsjoko	1.1	}
180
181			sub createSqlDb {
182			my $dsn = shift;
183	joko	1.10	my $dbname = dsn2dbname($dsn);
184	cvsjoko	1.2	print " - creating rdbms-database $dbname ($dsn) ...";
185	cvsjoko	1.1	my $sql;
186			$sql = "CREATE DATABASE $dbname;";
187	cvsjoko	1.2	if ( sqlDbAction($dsn, $sql) ) {
188	cvsjoko	1.3	print "ok", "\n";
189			return 1;
190	cvsjoko	1.2	} else {
191	cvsjoko	1.3	print "failed", "\n";
192			return 0;
193	cvsjoko	1.2	}
194	cvsjoko	1.1	}
195	cvsjoko	1.2
196	cvsjoko	1.1	sub dropSqlDb {
197			my $dsn = shift;
198	joko	1.10	my $dbname = dsn2dbname($dsn);
199	cvsjoko	1.1	print " - dropping database $dbname", "\n";
200			my $sql;
201			$sql = "DROP DATABASE $dbname;";
202			sqlDbAction($dsn, $sql);
203			}
204
205			sub testDsnForTables {
206			my $dsn = shift;
207			connectTarget($dsn);
208			my $result = sendSql('SHOW TABLES;');
209			my $bool_tablesHere = $result->fetchrow_hashref();
210			$result->finish();
211			disconnectTarget($dsn);
212			return 1 if ($bool_tablesHere);
213			}
214
215	cvsjoko	1.3	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26