ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.pm
Revision: 1.8
Committed: Mon Jan 22 10:53:36 2001 UTC (23 years, 4 months ago) by root
Branch: MAIN
CVS Tags: klinik_20010124
Changes since 1.7: +14 -5 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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     # to be written
9    
10     =head1 DESCRIPTION
11    
12     This module provides you with easy-to-use functions to execute sql
13     commands (using DBI). Despite being easy to use, they are also quite
14     efficient and allow you to write faster programs in less lines of code.
15    
16     =over 4
17    
18     =cut
19    
20     package PApp::SQL;
21    
22     use DBI;
23    
24     #use PApp::Exception; # not yet used
25    
26     BEGIN {
27     use base Exporter;
28    
29 root 1.4 $VERSION = 0.11;
30 root 1.1 @EXPORT = qw(
31     sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec
32     );
33     @EXPORT_OK = qw(
34     connect_cached
35     );
36    
37     require XSLoader;
38     XSLoader::load PApp::SQL, $VERSION;
39     }
40    
41     our $sql_exec; # last result of sql_exec's execute call
42     our $DBH; # the default database handle
43     our $database; # the current SQL::Database object, if applicable
44    
45     our %dbcache;
46    
47     =item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
48    
49     (not exported by by default)
50    
51     Connect to the database given by C<($dsn,$user,$pass)>, while using the
52     flags from C<$flags>. These are just the same arguments as given to
53     C<DBI->connect>.
54    
55 root 1.6 The database handle will be cached under the unique id
56     C<$id|$dsn|$user|$pass>. If the same id is requested later, the
57     cached handle will be checked (using ping), and the connection will
58     be re-established if necessary (be sure to prefix your application or
59     module name to the id to make it "more" unique. Things like __PACKAGE__ .
60     __LINE__ work fine as well).
61    
62     The reason C<$id> is necessary is that you might specify special connect
63     arguments or special flags, or you might want to configure your $DBH
64     differently than maybe other applications requesting the same database
65     connection. If none of this is becessary for your application you can
66     leave $id empty (i.e. "").
67 root 1.1
68     If specified, C<$connect> is a callback (e.g. a coderef) that will be
69     called each time a new connection is being established, with the new
70     C<$dbh> as first argument.
71    
72     Examples:
73    
74     # try your luck opening the papp database without access info
75     $dbh = connect_cached __FILE__, "DBI:mysql:papp";
76    
77     =cut
78    
79     sub connect_cached {
80     my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
81     # the following line is duplicated in PApp::SQL::Database::new
82     $id = "$id\0$dsn\0$user\0$pass";
83     unless ($dbcache{$id} && $dbcache{$id}->ping) {
84     #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
85 root 1.5 # first, nuke our statement cache (sooory ;)
86 root 1.1 cachesize cachesize 0;
87     # then connect anew
88     $dbcache{$id} =
89     eval { DBI->connect($dsn, $user, $pass, $flags) }
90     || eval { DBI->connect($dsn, $user, $pass, $flags) }
91 root 1.5 || die "unable to connect to database $dsn: $DBI::errstr\n";
92 root 1.1 $connect->($dbcache{$id}) if $connect;
93     }
94     $dbcache{$id};
95     }
96    
97     =item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...]
98    
99     C<sql_exec> is the most important and most-used function in this module.
100    
101     Runs the given sql command with the given parameters and returns the
102     statement handle. The command and the statement handle will be cached
103     (with the database handle and the sql string as key), so prepare will be
104     called only once for each distinct sql call (please keep in mind that the
105     returned statement will always be the same, so, if you call C<sql_exec>
106     with the same dbh and sql-statement twice (e.g. in a subroutine you
107     called), the statement handle for the first call mustn't be used.
108    
109     The database handle (the first argument) is optional. If it is missing,
110     C<sql_exec> first tries to use the variable C<$DBH> in the current (=
111     calling) package and, if that fails, it tries to use database handle in
112     C<$PApp::SQL::DBH>, which you can set before calling these functions.
113    
114     The actual return value from the C<$sth->execute> call is stored in the
115     package-global (and exported) variable C<$sql_exec>.
116    
117     If any error occurs C<sql_exec> will throw an exception.
118    
119     Examples:
120    
121     # easy one
122     my $st = sql_exec "select name, id from table where id = ?", $id;
123     while (my ($name, $id) = $st->fetchrow_array) { ... };
124    
125     # the fastest way to use dbi, using bind_columns
126     my $st = sql_exec \my($name, $id),
127     "select name, id from table where id = ?",
128     $id;
129     while ($st->fetch) { ...}
130    
131     # now use a different dastabase:
132     sql_exec $dbh, "update file set name = ?", "oops.txt";
133    
134    
135     =item sql_fetch <see sql_exec>
136    
137     Execute a sql-statement and fetch the first row of results. Depending on
138     the caller context the row will be returned as a list (array context), or
139     just the first columns. In table form:
140    
141     CONTEXT RESULT
142     void ()
143     scalar first column
144     list array
145    
146     C<sql_fetch> is quite efficient in conjunction with bind variables:
147    
148     sql_fetch \my($name, $amount),
149     "select name, amount from table where id name = ?",
150     "Toytest";
151    
152     But of course the normal way to call it is simply:
153    
154     my($name, $amount) = sql_fetch "select ...", args...
155    
156     ... and it's still quite fast unless you fetch large amounts of data.
157    
158     =item sql_fetchall <see sql_exec>
159    
160     Similarly to C<sql_fetch>, but all result rows will be fetched (this is
161     of course inefficient for large results!). The context is ignored (only
162     list context makes sense), but the result still depends on the number of
163     columns in the result:
164    
165     COLUMNS RESULT
166     0 ()
167     1 (row1, row2, row3...)
168     many ([row1], [row2], [row3]...)
169    
170     Examples (all of which are inefficient):
171    
172     for (sql_fetchall "select id from table") { ... }
173    
174     my @names = sql_fetchall "select name from user";
175    
176     for (sql_fetchall "select name, age, place from user") {
177     my ($name, $age, $place) = @$_;
178     }
179    
180     =item sql_exists "<table> where ...", args...
181    
182     Check wether the result of the sql-statement "select xxx from
183     $first_argument" would be empty or not (that is, imagine the string
184     "select from" were prepended to your statement (it isn't)). Should work
185     with every database but can be quite slow, except on mysql, where this
186     should be quite fast.
187    
188     Examples:
189    
190     print "user 7 exists!\n"
191     if sql_exists "user where id = ?", 7;
192    
193     die "duplicate key"
194     if sql_exists "user where name = ? and pass = ?", "stefan", "geheim";
195    
196     =cut
197    
198 root 1.3 =item $lastid = sql_insertid $sth
199    
200 root 1.8 Returns the last automatically created key value. It must be executed
201     directly after executing the insert statement that created it. This is
202     what is actually returned for various databases. If your database is
203     missing, please send me an e-mail on how to implement this ;)
204    
205     mysql: first C<AUTO_INCREMENT> column set to NULL
206     postgres: C<oid> column (is there a way to get the last SERIAL?)
207     sybase: C<IDENTITY> column of the last insert (slow)
208     informix: C<SERIAL> or C<SERIAL8> column of the last insert
209    
210     Except for sybase, this does not require a server access.
211 root 1.3
212     =cut
213    
214     sub sql_insertid($) {
215     my $sth = shift or die "sql_insertid requires a statement handle";
216     my $dbh = $sth->{Database};
217     my $driver = $dbh->{Driver}{Name};
218    
219 root 1.8 $driver eq "mysql" and return $sth->{mysql_insertid};
220     $driver eq "Pg" and return $sth->{pg_oid_status};
221     $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY');
222 root 1.3 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
223    
224     die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid";
225 root 1.1 }
226    
227     =item [old-size] = cachesize [new-size]
228    
229     Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
230     default is somewhere around 50 (= the 50 last recently used statements
231     will be cached). It shouldn't be too large, since a simple linear listed
232     is used for the cache at the moment (which, for small (<100) cache sizes
233     is actually quite fast).
234    
235     The function always returns the cache size in effect I<before> the call,
236     so, to nuke the cache (for example, when a database connection has died
237     or you want to garbage collect old database/statement handles), this
238     construct can be used:
239    
240     PApp::SQL::cachesize PApp::SQL::cachesize 0;
241    
242     =cut
243    
244     =item reinitialize [not exported]
245    
246     Clears any internal caches (statement cache, database handle cache).
247    
248     =cut
249    
250     sub reinitialize {
251     cachesize cachesize 0;
252     for (values %dbcache) {
253     eval { $_->disconnect };
254     }
255     undef %dbcache;
256     }
257    
258     =back
259    
260     =cut
261    
262 root 1.7 reinitialize;
263    
264 root 1.1 package PApp::SQL::Database;
265    
266     =head2 THE DATABASE CLASS
267    
268     Again (sigh) the problem of persistency. What do you do when you have to serialize on object
269     that contains (or should contain) a database handle? Short answer: you don't. Long answer:
270     you can embed the necessary information to recreate the dbh when needed.
271    
272     The C<PApp::SQL::Database> class does that, in a relatively efficient
273     fashion: the overhead is currently a single method call per access (you
274     can cache the real dbh if you want).
275    
276     =over 4
277    
278     =item $db = new <same arguments as C<connect_cached>>
279    
280     The C<new> call takes the same arguments as C<connect_cached> (obviously,
281     if you supply a connect callback it better is serializable, see
282     L<PApp::Callback>!) and returns a serializable database class. No database
283     handle is actually being created.
284    
285     =item $db->dbh
286    
287     Return the database handle as fast as possible (usually just a hash lookup).
288    
289     =item $db->checked_dbh
290    
291     Return the database handle, but first check that the database is still
292     available and re-open the connection if necessary.
293    
294     =cut
295    
296     sub new($$;@) {
297     my $class = shift;
298     my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
299     # the following line is duplicated in PApp::SQL::Database::new
300     my $id2 = "$id\0$dsn\0$user\0$pass";
301     bless [$id2, $flags, $connect], $class;
302     }
303    
304     # the following two functions better be fast!
305     sub dbh($) {
306     $dbcache{$_[0][0]} || $_[0]->checked_dbh;
307     }
308    
309     sub checked_dbh($) {
310     my $dbh = $dbcache{$_[0][0]};
311     $dbh && $dbh->ping
312     ? $dbh
313     : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]);
314     }
315    
316     =item $db->dsn
317    
318     Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
319    
320     =cut
321    
322     sub dsn($) {
323     my $self = shift;
324     $self->[1][1];
325     }
326    
327     =back
328    
329     =cut
330    
331     1;
332    
333     =head1 BUGS
334    
335     As of this writing, sql_fetch and sql_fetchall are not very well tested
336     (they were just re-written in C).
337    
338     sql_exists could be faster (it is written very ugly to not change the
339     current package).
340    
341     =head1 SEE ALSO
342    
343     L<PApp>.
344    
345     =head1 AUTHOR
346    
347     Marc Lehmann <pcg@goof.com>
348     http://www.goof.com/pcg/marc/
349    
350     =cut
351