/[cvs]/nfo/perl/libs/libdb.pm
ViewVC logotype

Contents of /nfo/perl/libs/libdb.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (show annotations)
Wed Apr 9 07:53:33 2003 UTC (20 years, 11 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.10: +6 -2 lines
minor namespace update

1 ## --------------------------------------------------------------------------------
2 ## $Id: libdb.pm,v 1.10 2003/04/08 23:07:57 joko Exp $
3 ## --------------------------------------------------------------------------------
4 ## $Log: libdb.pm,v $
5 ## 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 ## Revision 1.9 2003/02/09 04:47:58 joko
10 ## + minor fix
11 ##
12 ## Revision 1.8 2002/12/12 02:48:58 joko
13 ## + played with fixing disconnectTarget
14 ##
15 ## Revision 1.7 2002/12/01 22:13:17 joko
16 ## + minor bugfix?
17 ##
18 ## Revision 1.6 2002/11/29 04:53:39 joko
19 ## + hash2Sql now knows about SQL_SELECT
20 ##
21 ## Revision 1.5 2002/11/17 07:18:38 joko
22 ## + small modification in hash2sql
23 ##
24 ## Revision 1.4 2002/10/16 22:36:42 joko
25 ## + sub testDbServer
26 ##
27 ## Revision 1.3 2002/07/27 00:28:20 cvsjoko
28 ## bugfixes
29 ##
30 ## Revision 1.2 2002/07/20 11:09:58 cvsjoko
31 ## + bugfixes
32 ## + dont' print sql-errors
33 ##
34 ## Revision 1.1 2002/07/19 18:14:03 cvsjoko
35 ## no message
36 ##
37 ##
38 ## --------------------------------------------------------------------------------
39
40 package libdb;
41
42 use strict;
43 use warnings;
44
45 require Exporter;
46 our @ISA = qw( Exporter );
47 our @EXPORT_OK = qw(
48 testDsn
49 connectTarget disconnectTarget sendSql
50 dbNow
51 dsn2dbname sqlDbAction createSqlDb dropSqlDb
52 testDsnForTables testDbServer
53 );
54
55
56 use Carp;
57 use DBI;
58 use Data::Dumper;
59
60 use shortcuts::database qw( dsn2dbname );
61
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 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
91
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 if ($dbmeta->{dbh} = DBI->connect($dbmeta->{dsn}, '', '', { PrintError => 0 } )) {
114 $dbmeta->{dbh}->trace($dbmeta->{trace_level}, $dbmeta->{trace_file});
115 $dbmeta->{dbh}->{PrintError} = 0;
116 $dbmeta->{connected} = 1;
117 $dbmeta_ref_cache = $dbmeta;
118 return 1;
119 }
120 }
121 }
122
123 sub disconnectTarget {
124 #my $dbmeta = shift;
125 #print "disc\n";
126 #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 #print Dumper($dbmeta);
131 #$dbmeta->{dbh} && $dbmeta->{dbh}->disconnect();
132 $dbmeta->{dbh}->disconnect();
133 undef($dbmeta->{dbh});
134 undef($dbmeta);
135 undef($dbmeta_ref_cache);
136 }
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 #if ($result->execute()) {
151 $result->execute();
152 return $result;
153 #}
154 }
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 my $bool_ok;
174 if (connectTarget($dbmeta)) {
175 sendSql($sql);
176 #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 disconnectTarget($dbmeta);
181 }
182 return $bool_ok;
183 }
184
185 sub createSqlDb {
186 my $dsn = shift;
187 my $dbname = dsn2dbname($dsn);
188 print " - creating rdbms-database $dbname ($dsn) ...";
189 my $sql;
190 $sql = "CREATE DATABASE $dbname;";
191 if ( sqlDbAction($dsn, $sql) ) {
192 print "ok", "\n";
193 return 1;
194 } else {
195 print "failed", "\n";
196 return 0;
197 }
198 }
199
200 sub dropSqlDb {
201 my $dsn = shift;
202 my $dbname = dsn2dbname($dsn);
203 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 1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed