ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.pm
Revision: 1.43
Committed: Mon Mar 4 06:25:32 2019 UTC (5 years, 2 months ago) by root
Branch: MAIN
CVS Tags: rel-2_002, HEAD
Changes since 1.42: +4 -2 lines
Log Message:
2.002

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3 root 1.19 PApp::SQL - absolutely easy yet fast and powerful sql access.
4 root 1.1
5     =head1 SYNOPSIS
6    
7     use PApp::SQL;
8 root 1.10
9     my $st = sql_exec $DBH, "select ... where a = ?", $a;
10    
11     local $DBH = <database handle>;
12     my $st = sql_exec \my($bind_a, $bind_b), "select a,b ...";
13 root 1.37 my $id = sql_insertid
14 root 1.10 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 root 1.20 sql_exists "table where name like 'a%'"
19 root 1.10 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 root 1.1
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 root 1.42 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<sql_u*> family of functions) will
33     only be effective with perl version 5.006 and beyond.
34 root 1.10
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 root 1.1
40     =cut
41    
42     package PApp::SQL;
43    
44 root 1.38 use Carp ();
45 root 1.10 use DBI ();
46 root 1.1
47     BEGIN {
48 root 1.10 use base qw(Exporter DynaLoader);
49 root 1.1
50 root 1.43 $VERSION = '2.002';
51 root 1.1 @EXPORT = qw(
52 root 1.16 sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec
53     sql_uexec sql_ufetch sql_ufetchall sql_uexists
54 root 1.1 );
55     @EXPORT_OK = qw(
56     connect_cached
57     );
58    
59 root 1.10 bootstrap PApp::SQL $VERSION;
60 root 1.1 }
61    
62 root 1.40 boot2 DBI::SQL_VARCHAR, DBI::SQL_INTEGER, DBI::SQL_DOUBLE;
63    
64 root 1.1 our $sql_exec; # last result of sql_exec's execute call
65     our $DBH; # the default database handle
66 root 1.10 our $Database; # the current SQL::Database object, if applicable
67 root 1.1
68     our %dbcache;
69    
70 root 1.32 =head2 Global Variables
71 root 1.10
72     =over 4
73    
74     =item $sql_exec
75    
76     Since the C<sql_exec> family of functions return a statement handle there
77 root 1.22 must be another way to test the return value of the C<execute> call. This
78 root 1.10 global variable contains the result of the most recent call to C<execute>
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 root 1.24 specified as argument. See C<sql_exec> for a discussion.
85 root 1.10
86     =item $PApp::SQL::Database
87    
88     The current default C<PApp::SQL::Database>-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 root 1.32 =head2 Functions
97 root 1.10
98     =over 4
99    
100 root 1.1 =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 root 1.41 C<< DBI->connect >>.
107 root 1.1
108 root 1.6 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 root 1.22 connection. If none of this is necessary for your application you can
119     leave C<$id> empty (i.e. "").
120 root 1.1
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 root 1.19 Mysql-specific behaviour: The default setting of
131     C<mysql_client_found_rows> is TRUE, you can overwrite this, though.
132 root 1.18
133 root 1.1 =cut
134    
135     sub connect_cached {
136     my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
137     # the following line is duplicated in PApp::SQL::Database::new
138     $id = "$id\0$dsn\0$user\0$pass";
139     unless ($dbcache{$id} && $dbcache{$id}->ping) {
140 root 1.5 # first, nuke our statement cache (sooory ;)
141 root 1.1 cachesize cachesize 0;
142 root 1.18
143     # then make mysql behave more standardly by default
144     $dsn =~ /^[Dd][Bb][Ii]:mysql:/
145     and $dsn !~ /;mysql_client_found_rows/
146     and $dsn .= ";mysql_client_found_rows=1";
147    
148 root 1.1 # then connect anew
149     $dbcache{$id} =
150     eval { DBI->connect($dsn, $user, $pass, $flags) }
151     || eval { DBI->connect($dsn, $user, $pass, $flags) }
152 root 1.38 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
153 root 1.1 $connect->($dbcache{$id}) if $connect;
154     }
155     $dbcache{$id};
156     }
157    
158     =item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...]
159    
160 root 1.15 =item $sth = sql_uexec <see sql_exec>
161    
162 root 1.1 C<sql_exec> 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<sql_exec>
169     with the same dbh and sql-statement twice (e.g. in a subroutine you
170 root 1.23 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 root 1.1
173     The database handle (the first argument) is optional. If it is missing,
174 root 1.24 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<sql_exec> 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 root 1.1
188 root 1.41 The actual return value from the C<< $sth->execute >> call is stored in
189     the package-global (and exported) variable C<$sql_exec>.
190 root 1.1
191     If any error occurs C<sql_exec> will throw an exception.
192    
193 root 1.15 C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
194 root 1.31 UTF-8 before calling the C<execute> method.
195 root 1.15
196 root 1.1 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 <see sql_exec>
213    
214 root 1.15 =item sql_ufetch <see sql_uexec>
215    
216     Execute an sql-statement and fetch the first row of results. Depending on
217 root 1.1 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<sql_fetch> 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 root 1.15 C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
238 root 1.31 UTF-8 and forces all result values to UTF-8 (this does I<not> 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 root 1.15
245 root 1.1 =item sql_fetchall <see sql_exec>
246    
247 root 1.15 =item sql_ufetchall <see sql_uexec>
248    
249 root 1.1 Similarly to C<sql_fetch>, 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 root 1.15 C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
270 root 1.31 values to UTF-8 and forces all result values to UTF-8 (see the caveats in
271 root 1.21 the description of C<sql_ufetch>, though).
272 root 1.15
273 root 1.20 =item sql_exists "<table_references> where <where_condition>...", args...
274 root 1.1
275 root 1.15 =item sql_uexists <see sql_exists>
276    
277 root 1.1 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 root 1.13 "select * from" were prepended to your statement (it isn't)). Should work
280 root 1.1 with every database but can be quite slow, except on mysql, where this
281     should be quite fast.
282    
283 root 1.15 C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
284 root 1.31 UTF-8.
285 root 1.15
286 root 1.1 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 root 1.3 =item $lastid = sql_insertid $sth
297    
298 root 1.8 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 root 1.43 mariadb: first C<AUTO_INCREMENT> column set to NULL
304 root 1.8 mysql: first C<AUTO_INCREMENT> column set to NULL
305     postgres: C<oid> column (is there a way to get the last SERIAL?)
306     sybase: C<IDENTITY> column of the last insert (slow)
307     informix: C<SERIAL> or C<SERIAL8> column of the last insert
308 root 1.34 sqlite: C<last_insert_rowid()>
309 root 1.8
310     Except for sybase, this does not require a server access.
311 root 1.3
312     =cut
313    
314     sub sql_insertid($) {
315 root 1.38 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
316 root 1.3 my $dbh = $sth->{Database};
317     my $driver = $dbh->{Driver}{Name};
318    
319 root 1.43 $driver eq "MariaDB" and return $sth->{mariadb_insertid};
320 root 1.8 $driver eq "mysql" and return $sth->{mysql_insertid};
321     $driver eq "Pg" and return $sth->{pg_oid_status};
322 root 1.38 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
323 root 1.3 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
324 root 1.38 $driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()');
325 root 1.3
326 root 1.43 $dbh->last_insert_id (undef, undef, undef, undef)
327 root 1.1 }
328    
329     =item [old-size] = cachesize [new-size]
330    
331     Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
332     default is somewhere around 50 (= the 50 last recently used statements
333 root 1.26 will be cached). It shouldn't be too large, since a simple linear list
334 root 1.1 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<before> 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 root 1.9 Clears any internal caches (statement cache, database handle
349     cache). Should be called after C<fork> and other accidents that invalidate
350     database handles.
351 root 1.1
352     =cut
353    
354     sub reinitialize {
355     cachesize cachesize 0;
356     for (values %dbcache) {
357 root 1.11 eval { $_->{InactiveDestroy} = 1 };
358 root 1.1 }
359     undef %dbcache;
360     }
361    
362     =back
363    
364     =cut
365    
366 root 1.7 reinitialize;
367    
368 root 1.40 =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 root 1.1 package PApp::SQL::Database;
390    
391 root 1.32 =head2 The Database Class
392 root 1.1
393 root 1.15 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 root 1.1
398     The C<PApp::SQL::Database> 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 <same arguments as C<connect_cached>>
405    
406     The C<new> call takes the same arguments as C<connect_cached> (obviously,
407     if you supply a connect callback it better is serializable, see
408     L<PApp::Callback>!) 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     my $class = shift;
424     my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
425     # the following line is duplicated in PApp::SQL::Database::new
426     my $id2 = "$id\0$dsn\0$user\0$pass";
427     bless [$id2, $flags, $connect], $class;
428     }
429    
430     # the following two functions better be fast!
431     sub dbh($) {
432     $dbcache{$_[0][0]} || $_[0]->checked_dbh;
433     }
434    
435     sub checked_dbh($) {
436     my $dbh = $dbcache{$_[0][0]};
437     $dbh && $dbh->ping
438     ? $dbh
439 elmex 1.35 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
440 root 1.1 }
441    
442     =item $db->dsn
443    
444     Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
445    
446 root 1.14 =item $db->login
447    
448     Return the login name.
449    
450     =item $db->password
451    
452 root 1.25 Return the password (emphasizing the fact that the password is stored plaintext ;)
453 root 1.14
454 root 1.1 =cut
455    
456     sub dsn($) {
457     my $self = shift;
458 root 1.9 (split /\x00/, $self->[0])[1];
459 root 1.14 }
460    
461     sub login($) {
462     my $self = shift;
463     (split /\x00/, $self->[0])[2];
464     }
465    
466     sub password($) {
467     my $self = shift;
468     (split /\x00/, $self->[0])[3];
469 root 1.1 }
470    
471     =back
472    
473     =cut
474    
475     1;
476    
477     =head1 SEE ALSO
478    
479     L<PApp>.
480    
481     =head1 AUTHOR
482    
483 root 1.32 Marc Lehmann <schmorp@schmorp.de>
484     http://home.schmorp.de/
485 root 1.1
486     =cut
487