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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (hide annotations)
Tue Apr 8 23:07:57 2003 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.9: +9 -70 lines
renamed core database helper functions
moved 'hash2Sql' and 'quotesql' to shortcuts::db

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 RSS 2.0 feed