ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.pm
Revision: 1.30
Committed: Wed Jan 28 19:50:38 2004 UTC (20 years, 3 months ago) by stefan
Branch: MAIN
Changes since 1.29: +4 -2 lines
Log Message:
*** empty log message ***

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