line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
PApp::SQL - absolutely easy yet fast and powerful sql access. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use PApp::SQL; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my $st = sql_exec $DBH, "select ... where a = ?", $a; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
local $DBH = ; |
12
|
|
|
|
|
|
|
my $st = sql_exec \my($bind_a, $bind_b), "select a,b ..."; |
13
|
|
|
|
|
|
|
my $id = sql_insertid |
14
|
|
|
|
|
|
|
sql_exec "insert into ... values (?, ?)", $v1, $v2; |
15
|
|
|
|
|
|
|
my $a = sql_fetch "select a from ..."; |
16
|
|
|
|
|
|
|
sql_fetch \my($a, $b), "select a,b ..."; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sql_exists "table where name like 'a%'" |
19
|
|
|
|
|
|
|
or die "a* required but not existent"; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $db = new PApp::SQL::Database "", "DBI:mysql:test", "user", "pass"; |
22
|
|
|
|
|
|
|
local $PApp::SQL::DBH = $db->checked_dbh; # does 'ping' |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sql_exec $db->dbh, "select ..."; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This module provides you with easy-to-use functions to execute sql |
29
|
|
|
|
|
|
|
commands (using DBI). Despite being easy to use, they are also quite |
30
|
|
|
|
|
|
|
efficient and allow you to write faster programs in fewer lines of |
31
|
|
|
|
|
|
|
code. It should work with anything from perl-5.004_01 onwards, but I only |
32
|
|
|
|
|
|
|
support 5.005+. UTF8 handling (the C family of functions) will |
33
|
|
|
|
|
|
|
only be effective with perl version 5.006 and beyond. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
If the descriptions here seem terse or if you always wanted to know |
36
|
|
|
|
|
|
|
what PApp is then have a look at the PApp module which uses this module |
37
|
|
|
|
|
|
|
extensively but also provides you with a lot more gimmicks to play around |
38
|
|
|
|
|
|
|
with to help you create cool applications ;) |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=cut |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
package PApp::SQL; |
43
|
|
|
|
|
|
|
|
44
|
2
|
|
|
2
|
|
1492
|
use Carp (); |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
45
|
|
45
|
2
|
|
|
2
|
|
3091
|
use DBI (); |
|
2
|
|
|
|
|
37665
|
|
|
2
|
|
|
|
|
112
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
BEGIN { |
48
|
2
|
|
|
2
|
|
19
|
use base qw(Exporter DynaLoader); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
493
|
|
49
|
|
|
|
|
|
|
|
50
|
2
|
|
|
2
|
|
8
|
$VERSION = '2.002'; |
51
|
2
|
|
|
|
|
7
|
@EXPORT = qw( |
52
|
|
|
|
|
|
|
sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec |
53
|
|
|
|
|
|
|
sql_uexec sql_ufetch sql_ufetchall sql_uexists |
54
|
|
|
|
|
|
|
); |
55
|
2
|
|
|
|
|
5
|
@EXPORT_OK = qw( |
56
|
|
|
|
|
|
|
connect_cached |
57
|
|
|
|
|
|
|
); |
58
|
|
|
|
|
|
|
|
59
|
2
|
|
|
|
|
2674
|
bootstrap PApp::SQL $VERSION; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
boot2 DBI::SQL_VARCHAR, DBI::SQL_INTEGER, DBI::SQL_DOUBLE; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
our $sql_exec; # last result of sql_exec's execute call |
65
|
|
|
|
|
|
|
our $DBH; # the default database handle |
66
|
|
|
|
|
|
|
our $Database; # the current SQL::Database object, if applicable |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
our %dbcache; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head2 Global Variables |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=over 4 |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item $sql_exec |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Since the C family of functions return a statement handle there |
77
|
|
|
|
|
|
|
must be another way to test the return value of the C call. This |
78
|
|
|
|
|
|
|
global variable contains the result of the most recent call to C |
79
|
|
|
|
|
|
|
done by this module. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item $PApp::SQL::DBH |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
The default database handle used by this module if no C<$DBH> was |
84
|
|
|
|
|
|
|
specified as argument. See C for a discussion. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item $PApp::SQL::Database |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The current default C-object. Future versions might |
89
|
|
|
|
|
|
|
automatically fall back on this database and create database handles from |
90
|
|
|
|
|
|
|
it if neccessary. At the moment this is not used by this module but might |
91
|
|
|
|
|
|
|
be nice as a placeholder for the database object that corresponds to |
92
|
|
|
|
|
|
|
$PApp::SQL::DBH. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=back |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 Functions |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=over 4 |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
(not exported by by default) |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Connect to the database given by C<($dsn,$user,$pass)>, while using the |
105
|
|
|
|
|
|
|
flags from C<$flags>. These are just the same arguments as given to |
106
|
|
|
|
|
|
|
C<< DBI->connect >>. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
The database handle will be cached under the unique id |
109
|
|
|
|
|
|
|
C<$id|$dsn|$user|$pass>. If the same id is requested later, the |
110
|
|
|
|
|
|
|
cached handle will be checked (using ping), and the connection will |
111
|
|
|
|
|
|
|
be re-established if necessary (be sure to prefix your application or |
112
|
|
|
|
|
|
|
module name to the id to make it "more" unique. Things like __PACKAGE__ . |
113
|
|
|
|
|
|
|
__LINE__ work fine as well). |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
The reason C<$id> is necessary is that you might specify special connect |
116
|
|
|
|
|
|
|
arguments or special flags, or you might want to configure your $DBH |
117
|
|
|
|
|
|
|
differently than maybe other applications requesting the same database |
118
|
|
|
|
|
|
|
connection. If none of this is necessary for your application you can |
119
|
|
|
|
|
|
|
leave C<$id> empty (i.e. ""). |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
If specified, C<$connect> is a callback (e.g. a coderef) that will be |
122
|
|
|
|
|
|
|
called each time a new connection is being established, with the new |
123
|
|
|
|
|
|
|
C<$dbh> as first argument. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Examples: |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# try your luck opening the papp database without access info |
128
|
|
|
|
|
|
|
$dbh = connect_cached __FILE__, "DBI:mysql:papp"; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Mysql-specific behaviour: The default setting of |
131
|
|
|
|
|
|
|
C is TRUE, you can overwrite this, though. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub connect_cached { |
136
|
0
|
|
|
0
|
1
|
0
|
my ($id, $dsn, $user, $pass, $flags, $connect) = @_; |
137
|
|
|
|
|
|
|
# the following line is duplicated in PApp::SQL::Database::new |
138
|
0
|
|
|
|
|
0
|
$id = "$id\0$dsn\0$user\0$pass"; |
139
|
0
|
0
|
0
|
|
|
0
|
unless ($dbcache{$id} && $dbcache{$id}->ping) { |
140
|
|
|
|
|
|
|
# first, nuke our statement cache (sooory ;) |
141
|
0
|
|
|
|
|
0
|
cachesize cachesize 0; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# then make mysql behave more standardly by default |
144
|
0
|
0
|
0
|
|
|
0
|
$dsn =~ /^[Dd][Bb][Ii]:mysql:/ |
145
|
|
|
|
|
|
|
and $dsn !~ /;mysql_client_found_rows/ |
146
|
|
|
|
|
|
|
and $dsn .= ";mysql_client_found_rows=1"; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# then connect anew |
149
|
|
|
|
|
|
|
$dbcache{$id} = |
150
|
|
|
|
|
|
|
eval { DBI->connect($dsn, $user, $pass, $flags) } |
151
|
0
|
|
0
|
|
|
0
|
|| eval { DBI->connect($dsn, $user, $pass, $flags) } |
152
|
|
|
|
|
|
|
|| Carp::croak "unable to connect to database $dsn: $DBI::errstr\n"; |
153
|
0
|
0
|
|
|
|
0
|
$connect->($dbcache{$id}) if $connect; |
154
|
|
|
|
|
|
|
} |
155
|
0
|
|
|
|
|
0
|
$dbcache{$id}; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...] |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item $sth = sql_uexec |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
C is the most important and most-used function in this module. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Runs the given sql command with the given parameters and returns the |
165
|
|
|
|
|
|
|
statement handle. The command and the statement handle will be cached |
166
|
|
|
|
|
|
|
(with the database handle and the sql string as key), so prepare will be |
167
|
|
|
|
|
|
|
called only once for each distinct sql call (please keep in mind that the |
168
|
|
|
|
|
|
|
returned statement will always be the same, so, if you call C |
169
|
|
|
|
|
|
|
with the same dbh and sql-statement twice (e.g. in a subroutine you |
170
|
|
|
|
|
|
|
called), the statement handle for the first call mustn't not be in use |
171
|
|
|
|
|
|
|
anymore, as the subsequent call will re-use the handle. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
The database handle (the first argument) is optional. If it is missing, |
174
|
|
|
|
|
|
|
it tries to use database handle in C<$PApp::SQL::DBH>, which you can set |
175
|
|
|
|
|
|
|
before calling these functions. NOTICE: future and former versions of |
176
|
|
|
|
|
|
|
PApp::SQL might also look up the global variable C<$DBH> in the callers |
177
|
|
|
|
|
|
|
package. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=begin comment |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
If it is missing, C first tries to use the variable C<$DBH> |
182
|
|
|
|
|
|
|
in the current (= calling) package and, if that fails, it tries to use |
183
|
|
|
|
|
|
|
database handle in C<$PApp::SQL::DBH>, which you can set before calling |
184
|
|
|
|
|
|
|
these functions. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=end comment |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
The actual return value from the C<< $sth->execute >> call is stored in |
189
|
|
|
|
|
|
|
the package-global (and exported) variable C<$sql_exec>. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
If any error occurs C will throw an exception. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
C is similar to C but upgrades all input arguments to |
194
|
|
|
|
|
|
|
UTF-8 before calling the C method. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Examples: |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# easy one |
199
|
|
|
|
|
|
|
my $st = sql_exec "select name, id from table where id = ?", $id; |
200
|
|
|
|
|
|
|
while (my ($name, $id) = $st->fetchrow_array) { ... }; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# the fastest way to use dbi, using bind_columns |
203
|
|
|
|
|
|
|
my $st = sql_exec \my($name, $id), |
204
|
|
|
|
|
|
|
"select name, id from table where id = ?", |
205
|
|
|
|
|
|
|
$id; |
206
|
|
|
|
|
|
|
while ($st->fetch) { ...} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# now use a different dastabase: |
209
|
|
|
|
|
|
|
sql_exec $dbh, "update file set name = ?", "oops.txt"; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item sql_fetch |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=item sql_ufetch |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Execute an sql-statement and fetch the first row of results. Depending on |
217
|
|
|
|
|
|
|
the caller context the row will be returned as a list (array context), or |
218
|
|
|
|
|
|
|
just the first columns. In table form: |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
CONTEXT RESULT |
221
|
|
|
|
|
|
|
void () |
222
|
|
|
|
|
|
|
scalar first column |
223
|
|
|
|
|
|
|
list array |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
C is quite efficient in conjunction with bind variables: |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sql_fetch \my($name, $amount), |
228
|
|
|
|
|
|
|
"select name, amount from table where id name = ?", |
229
|
|
|
|
|
|
|
"Toytest"; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
But of course the normal way to call it is simply: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
my($name, $amount) = sql_fetch "select ...", args... |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
... and it's still quite fast unless you fetch large amounts of data. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
C is similar to C but upgrades all input values to |
238
|
|
|
|
|
|
|
UTF-8 and forces all result values to UTF-8 (this does I include result |
239
|
|
|
|
|
|
|
parameters, only return values. Using bind variables in conjunction with |
240
|
|
|
|
|
|
|
sql_u* functions might result in undefined behaviour - we use UTF-8 on |
241
|
|
|
|
|
|
|
bind-variables at execution time and it seems to work on DBD::mysql as it |
242
|
|
|
|
|
|
|
ignores the UTF-8 bit completely. Which just means that that DBD-driver is |
243
|
|
|
|
|
|
|
broken). |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item sql_fetchall |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item sql_ufetchall |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Similarly to C, but all result rows will be fetched (this is |
250
|
|
|
|
|
|
|
of course inefficient for large results!). The context is ignored (only |
251
|
|
|
|
|
|
|
list context makes sense), but the result still depends on the number of |
252
|
|
|
|
|
|
|
columns in the result: |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
COLUMNS RESULT |
255
|
|
|
|
|
|
|
0 () |
256
|
|
|
|
|
|
|
1 (row1, row2, row3...) |
257
|
|
|
|
|
|
|
many ([row1], [row2], [row3]...) |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Examples (all of which are inefficient): |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
for (sql_fetchall "select id from table") { ... } |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
my @names = sql_fetchall "select name from user"; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
for (sql_fetchall "select name, age, place from user") { |
266
|
|
|
|
|
|
|
my ($name, $age, $place) = @$_; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
C is similar to C but upgrades all input |
270
|
|
|
|
|
|
|
values to UTF-8 and forces all result values to UTF-8 (see the caveats in |
271
|
|
|
|
|
|
|
the description of C, though). |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=item sql_exists " where ...", args... |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=item sql_uexists |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Check wether the result of the sql-statement "select xxx from |
278
|
|
|
|
|
|
|
$first_argument" would be empty or not (that is, imagine the string |
279
|
|
|
|
|
|
|
"select * from" were prepended to your statement (it isn't)). Should work |
280
|
|
|
|
|
|
|
with every database but can be quite slow, except on mysql, where this |
281
|
|
|
|
|
|
|
should be quite fast. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
C is similar to C but upgrades all parameters to |
284
|
|
|
|
|
|
|
UTF-8. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
Examples: |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
print "user 7 exists!\n" |
289
|
|
|
|
|
|
|
if sql_exists "user where id = ?", 7; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
die "duplicate key" |
292
|
|
|
|
|
|
|
if sql_exists "user where name = ? and pass = ?", "stefan", "geheim"; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=cut |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item $lastid = sql_insertid $sth |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Returns the last automatically created key value. It must be executed |
299
|
|
|
|
|
|
|
directly after executing the insert statement that created it. This is |
300
|
|
|
|
|
|
|
what is actually returned for various databases. If your database is |
301
|
|
|
|
|
|
|
missing, please send me an e-mail on how to implement this ;) |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
mariadb: first C column set to NULL |
304
|
|
|
|
|
|
|
mysql: first C column set to NULL |
305
|
|
|
|
|
|
|
postgres: C column (is there a way to get the last SERIAL?) |
306
|
|
|
|
|
|
|
sybase: C column of the last insert (slow) |
307
|
|
|
|
|
|
|
informix: C or C column of the last insert |
308
|
|
|
|
|
|
|
sqlite: C |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Except for sybase, this does not require a server access. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=cut |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub sql_insertid($) { |
315
|
0
|
0
|
|
0
|
1
|
0
|
my $sth = shift or Carp::croak "sql_insertid requires a statement handle"; |
316
|
0
|
|
|
|
|
0
|
my $dbh = $sth->{Database}; |
317
|
0
|
|
|
|
|
0
|
my $driver = $dbh->{Driver}{Name}; |
318
|
|
|
|
|
|
|
|
319
|
0
|
0
|
|
|
|
0
|
$driver eq "MariaDB" and return $sth->{mariadb_insertid}; |
320
|
0
|
0
|
|
|
|
0
|
$driver eq "mysql" and return $sth->{mysql_insertid}; |
321
|
0
|
0
|
|
|
|
0
|
$driver eq "Pg" and return $sth->{pg_oid_status}; |
322
|
0
|
0
|
|
|
|
0
|
$driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY'); |
323
|
0
|
0
|
|
|
|
0
|
$driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; |
324
|
0
|
0
|
|
|
|
0
|
$driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()'); |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
0
|
$dbh->last_insert_id (undef, undef, undef, undef) |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=item [old-size] = cachesize [new-size] |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Returns (and possibly changes) the LRU cache size used by C. The |
332
|
|
|
|
|
|
|
default is somewhere around 50 (= the 50 last recently used statements |
333
|
|
|
|
|
|
|
will be cached). It shouldn't be too large, since a simple linear list |
334
|
|
|
|
|
|
|
is used for the cache at the moment (which, for small (<100) cache sizes |
335
|
|
|
|
|
|
|
is actually quite fast). |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
The function always returns the cache size in effect I the call, |
338
|
|
|
|
|
|
|
so, to nuke the cache (for example, when a database connection has died |
339
|
|
|
|
|
|
|
or you want to garbage collect old database/statement handles), this |
340
|
|
|
|
|
|
|
construct can be used: |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
PApp::SQL::cachesize PApp::SQL::cachesize 0; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=cut |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=item reinitialize [not exported] |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Clears any internal caches (statement cache, database handle |
349
|
|
|
|
|
|
|
cache). Should be called after C and other accidents that invalidate |
350
|
|
|
|
|
|
|
database handles. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=cut |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub reinitialize { |
355
|
2
|
|
|
2
|
1
|
9
|
cachesize cachesize 0; |
356
|
2
|
|
|
|
|
7
|
for (values %dbcache) { |
357
|
0
|
|
|
|
|
0
|
eval { $_->{InactiveDestroy} = 1 }; |
|
0
|
|
|
|
|
0
|
|
358
|
|
|
|
|
|
|
} |
359
|
2
|
|
|
|
|
6
|
undef %dbcache; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=back |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
reinitialize; |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=head2 Type Deduction |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
Since every database driver seems to deduce parameter types differently, |
371
|
|
|
|
|
|
|
usually wrongly, and at leats in the case of DBD::mysql, different in |
372
|
|
|
|
|
|
|
every other release or so, and this can and does lead to data corruption, |
373
|
|
|
|
|
|
|
this module does type deduction itself. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
What does it mean? Simple - sql parameters for placeholders will be |
376
|
|
|
|
|
|
|
explicitly marked as SQL_VARCHAR, SQL_INTEGER or SQL_DOUBLE the first time |
377
|
|
|
|
|
|
|
a statement is prepared. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
To force a specific type, you can either continue to use e.g. sql casts, |
380
|
|
|
|
|
|
|
or you can make sure to consistently use strings or numbers. To make a |
381
|
|
|
|
|
|
|
perl scalar look enough like a string or a number, use this when passing |
382
|
|
|
|
|
|
|
it to sql_exec or a similar functions: |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
"$string" # to pass a string |
385
|
|
|
|
|
|
|
$num+0 # to pass a number |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=cut |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
package PApp::SQL::Database; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=head2 The Database Class |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Again (sigh) the problem of persistency. What do you do when you have |
394
|
|
|
|
|
|
|
to serialize on object that contains (or should contain) a database |
395
|
|
|
|
|
|
|
handle? Short answer: you don't. Long answer: you can embed the necessary |
396
|
|
|
|
|
|
|
information to recreate the dbh when needed. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
The C class does that, in a relatively efficient |
399
|
|
|
|
|
|
|
fashion: the overhead is currently a single method call per access (you |
400
|
|
|
|
|
|
|
can cache the real dbh if you want). |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=over 4 |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=item $db = new > |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
The C call takes the same arguments as C (obviously, |
407
|
|
|
|
|
|
|
if you supply a connect callback it better is serializable, see |
408
|
|
|
|
|
|
|
L!) and returns a serializable database class. No database |
409
|
|
|
|
|
|
|
handle is actually being created. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=item $db->dbh |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
Return the database handle as fast as possible (usually just a hash lookup). |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=item $db->checked_dbh |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
Return the database handle, but first check that the database is still |
418
|
|
|
|
|
|
|
available and re-open the connection if necessary. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=cut |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub new($$;@) { |
423
|
1
|
|
|
1
|
|
118
|
my $class = shift; |
424
|
1
|
|
|
|
|
7
|
my ($id, $dsn, $user, $pass, $flags, $connect) = @_; |
425
|
|
|
|
|
|
|
# the following line is duplicated in PApp::SQL::Database::new |
426
|
1
|
|
|
|
|
5
|
my $id2 = "$id\0$dsn\0$user\0$pass"; |
427
|
1
|
|
|
|
|
5
|
bless [$id2, $flags, $connect], $class; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# the following two functions better be fast! |
431
|
|
|
|
|
|
|
sub dbh($) { |
432
|
0
|
0
|
|
0
|
|
0
|
$dbcache{$_[0][0]} || $_[0]->checked_dbh; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub checked_dbh($) { |
436
|
0
|
|
|
0
|
|
0
|
my $dbh = $dbcache{$_[0][0]}; |
437
|
0
|
0
|
0
|
|
|
0
|
$dbh && $dbh->ping |
438
|
|
|
|
|
|
|
? $dbh |
439
|
|
|
|
|
|
|
: PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=item $db->dsn |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Return the DSN (L) fo the database object (e.g. for error messages). |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item $db->login |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Return the login name. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item $db->password |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
Return the password (emphasizing the fact that the password is stored plaintext ;) |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=cut |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub dsn($) { |
457
|
1
|
|
|
1
|
|
7
|
my $self = shift; |
458
|
1
|
|
|
|
|
12
|
(split /\x00/, $self->[0])[1]; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
sub login($) { |
462
|
0
|
|
|
0
|
|
|
my $self = shift; |
463
|
0
|
|
|
|
|
|
(split /\x00/, $self->[0])[2]; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub password($) { |
467
|
0
|
|
|
0
|
|
|
my $self = shift; |
468
|
0
|
|
|
|
|
|
(split /\x00/, $self->[0])[3]; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=back |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=cut |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
1; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=head1 SEE ALSO |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
L. |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head1 AUTHOR |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Marc Lehmann |
484
|
|
|
|
|
|
|
http://home.schmorp.de/ |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=cut |
487
|
|
|
|
|
|
|
|