perl/libs/libdb.pm

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