File Coverage

blib/lib/PApp/SQL.pm
Criterion Covered Total %
statement 22 49 44.9
branch 0 24 0.0
condition 0 12 0.0
subroutine 7 13 53.8
pod 3 3 100.0
total 32 101 31.6


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