ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PApp-SQL/SQL.pm
(Generate patch)

Comparing PApp-SQL/SQL.pm (file contents):
Revision 1.12 by root, Mon Feb 12 17:47:10 2001 UTC vs.
Revision 1.38 by root, Sat Jun 20 21:03:50 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3PApp::SQL - absolutely easy yet fast and powerful sql access 3PApp::SQL - absolutely easy yet fast and powerful sql access.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use PApp::SQL; 7 use PApp::SQL;
8 8
9 my $st = sql_exec $DBH, "select ... where a = ?", $a; 9 my $st = sql_exec $DBH, "select ... where a = ?", $a;
10 10
11 local $DBH = <database handle>; 11 local $DBH = <database handle>;
12 my $st = sql_exec \my($bind_a, $bind_b), "select a,b ..."; 12 my $st = sql_exec \my($bind_a, $bind_b), "select a,b ...";
13 my $st = sql_insertid 13 my $id = sql_insertid
14 sql_exec "insert into ... values (?, ?)", $v1, $v2; 14 sql_exec "insert into ... values (?, ?)", $v1, $v2;
15 my $a = sql_fetch "select a from ..."; 15 my $a = sql_fetch "select a from ...";
16 sql_fetch \my($a, $b), "select a,b ..."; 16 sql_fetch \my($a, $b), "select a,b ...";
17 17
18 sql_exists "name from table where name like 'a%'" 18 sql_exists "table where name like 'a%'"
19 or die "a* required but not existent"; 19 or die "a* required but not existent";
20 20
21 my $db = new PApp::SQL::Database "", "DBI:mysql:test", "user", "pass"; 21 my $db = new PApp::SQL::Database "", "DBI:mysql:test", "user", "pass";
22 local $PApp::SQL::DBH = $db->checked_dbh; # does 'ping' 22 local $PApp::SQL::DBH = $db->checked_dbh; # does 'ping'
23 23
27 27
28This module provides you with easy-to-use functions to execute sql 28This module provides you with easy-to-use functions to execute sql
29commands (using DBI). Despite being easy to use, they are also quite 29commands (using DBI). Despite being easy to use, they are also quite
30efficient and allow you to write faster programs in less lines of code. It 30efficient and allow you to write faster programs in less lines of code. It
31should work with anything from perl-5.004_01 onwards, but I only support 31should work with anything from perl-5.004_01 onwards, but I only support
325.005+. 325.005+. UTF8 handling (the C<sql_u*> family of functions) will only be
33effective with perl version 5.006 and beyond.
33 34
34If the descriptions here seem terse or if you always wanted to know 35If the descriptions here seem terse or if you always wanted to know
35what PApp is then have a look at the PApp module which uses this module 36what PApp is then have a look at the PApp module which uses this module
36extensively but also provides you with a lot more gimmicks to play around 37extensively but also provides you with a lot more gimmicks to play around
37with to help you create cool applications ;) 38with to help you create cool applications ;)
38 39
39=cut 40=cut
40 41
41package PApp::SQL; 42package PApp::SQL;
42 43
44use Carp ();
43use DBI (); 45use DBI ();
44 46
45BEGIN { 47BEGIN {
46 use base qw(Exporter DynaLoader); 48 use base qw(Exporter DynaLoader);
47 49
48 $VERSION = 0.121; 50 $VERSION = '1.04';
49 @EXPORT = qw( 51 @EXPORT = qw(
50 sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec 52 sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec
53 sql_uexec sql_ufetch sql_ufetchall sql_uexists
51 ); 54 );
52 @EXPORT_OK = qw( 55 @EXPORT_OK = qw(
53 connect_cached 56 connect_cached
54 ); 57 );
55 58
60our $DBH; # the default database handle 63our $DBH; # the default database handle
61our $Database; # the current SQL::Database object, if applicable 64our $Database; # the current SQL::Database object, if applicable
62 65
63our %dbcache; 66our %dbcache;
64 67
65=head2 GLOBAL VARIABLES 68=head2 Global Variables
66 69
67=over 4 70=over 4
68 71
69=item $sql_exec 72=item $sql_exec
70 73
71Since the C<sql_exec> family of functions return a statement handle there 74Since the C<sql_exec> family of functions return a statement handle there
72must eb another way to test the return value of the C<execute> call. This 75must be another way to test the return value of the C<execute> call. This
73global variable contains the result of the most recent call to C<execute> 76global variable contains the result of the most recent call to C<execute>
74done by this module. 77done by this module.
75 78
76=item $PApp::SQL::DBH 79=item $PApp::SQL::DBH
77 80
78The default database handle used by this module if no C<$DBH> was 81The default database handle used by this module if no C<$DBH> was
79specified as argument and no C<$DBH> is found in the current package. See 82specified as argument. See C<sql_exec> for a discussion.
80C<sql_exec> for a discussion.
81 83
82=item $PApp::SQL::Database 84=item $PApp::SQL::Database
83 85
84The current default C<PApp::SQL::Database>-object. Future versions might 86The current default C<PApp::SQL::Database>-object. Future versions might
85automatically fall back on this database and create database handles from 87automatically fall back on this database and create database handles from
87be nice as a placeholder for the database object that corresponds to 89be nice as a placeholder for the database object that corresponds to
88$PApp::SQL::DBH. 90$PApp::SQL::DBH.
89 91
90=back 92=back
91 93
92=head2 FUNCTIONS 94=head2 Functions
93 95
94=over 4 96=over 4
95 97
96=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
97 99
109__LINE__ work fine as well). 111__LINE__ work fine as well).
110 112
111The reason C<$id> is necessary is that you might specify special connect 113The reason C<$id> is necessary is that you might specify special connect
112arguments or special flags, or you might want to configure your $DBH 114arguments or special flags, or you might want to configure your $DBH
113differently than maybe other applications requesting the same database 115differently than maybe other applications requesting the same database
114connection. If none of this is becessary for your application you can 116connection. If none of this is necessary for your application you can
115leave $id empty (i.e. ""). 117leave C<$id> empty (i.e. "").
116 118
117If specified, C<$connect> is a callback (e.g. a coderef) that will be 119If specified, C<$connect> is a callback (e.g. a coderef) that will be
118called each time a new connection is being established, with the new 120called each time a new connection is being established, with the new
119C<$dbh> as first argument. 121C<$dbh> as first argument.
120 122
121Examples: 123Examples:
122 124
123 # try your luck opening the papp database without access info 125 # try your luck opening the papp database without access info
124 $dbh = connect_cached __FILE__, "DBI:mysql:papp"; 126 $dbh = connect_cached __FILE__, "DBI:mysql:papp";
127
128Mysql-specific behaviour: The default setting of
129C<mysql_client_found_rows> is TRUE, you can overwrite this, though.
125 130
126=cut 131=cut
127 132
128sub connect_cached { 133sub connect_cached {
129 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 134 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
130 # the following line is duplicated in PApp::SQL::Database::new 135 # the following line is duplicated in PApp::SQL::Database::new
131 $id = "$id\0$dsn\0$user\0$pass"; 136 $id = "$id\0$dsn\0$user\0$pass";
132 unless ($dbcache{$id} && $dbcache{$id}->ping) { 137 unless ($dbcache{$id} && $dbcache{$id}->ping) {
133 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
134 # first, nuke our statement cache (sooory ;) 138 # first, nuke our statement cache (sooory ;)
135 cachesize cachesize 0; 139 cachesize cachesize 0;
140
141 # then make mysql behave more standardly by default
142 $dsn =~ /^[Dd][Bb][Ii]:mysql:/
143 and $dsn !~ /;mysql_client_found_rows/
144 and $dsn .= ";mysql_client_found_rows=1";
145
136 # then connect anew 146 # then connect anew
137 $dbcache{$id} = 147 $dbcache{$id} =
138 eval { DBI->connect($dsn, $user, $pass, $flags) } 148 eval { DBI->connect($dsn, $user, $pass, $flags) }
139 || eval { DBI->connect($dsn, $user, $pass, $flags) } 149 || eval { DBI->connect($dsn, $user, $pass, $flags) }
140 || die "unable to connect to database $dsn: $DBI::errstr\n"; 150 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
141 $connect->($dbcache{$id}) if $connect; 151 $connect->($dbcache{$id}) if $connect;
142 } 152 }
143 $dbcache{$id}; 153 $dbcache{$id};
144} 154}
145 155
146=item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...] 156=item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...]
157
158=item $sth = sql_uexec <see sql_exec>
147 159
148C<sql_exec> is the most important and most-used function in this module. 160C<sql_exec> is the most important and most-used function in this module.
149 161
150Runs the given sql command with the given parameters and returns the 162Runs the given sql command with the given parameters and returns the
151statement handle. The command and the statement handle will be cached 163statement handle. The command and the statement handle will be cached
152(with the database handle and the sql string as key), so prepare will be 164(with the database handle and the sql string as key), so prepare will be
153called only once for each distinct sql call (please keep in mind that the 165called only once for each distinct sql call (please keep in mind that the
154returned statement will always be the same, so, if you call C<sql_exec> 166returned statement will always be the same, so, if you call C<sql_exec>
155with the same dbh and sql-statement twice (e.g. in a subroutine you 167with the same dbh and sql-statement twice (e.g. in a subroutine you
156called), the statement handle for the first call mustn't be used. 168called), the statement handle for the first call mustn't not be in use
169anymore, as the subsequent call will re-use the handle.
157 170
158The database handle (the first argument) is optional. If it is missing, 171The database handle (the first argument) is optional. If it is missing,
159C<sql_exec> first tries to use the variable C<$DBH> in the current (= 172it tries to use database handle in C<$PApp::SQL::DBH>, which you can set
160calling) package and, if that fails, it tries to use database handle in 173before calling these functions. NOTICE: future and former versions of
161C<$PApp::SQL::DBH>, which you can set before calling these functions. 174PApp::SQL might also look up the global variable C<$DBH> in the callers
175package.
176
177=begin comment
178
179If it is missing, C<sql_exec> first tries to use the variable C<$DBH>
180in the current (= calling) package and, if that fails, it tries to use
181database handle in C<$PApp::SQL::DBH>, which you can set before calling
182these functions.
183
184=end comment
162 185
163The actual return value from the C<$sth->execute> call is stored in the 186The actual return value from the C<$sth->execute> call is stored in the
164package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
165 188
166If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
190
191C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
192UTF-8 before calling the C<execute> method.
167 193
168Examples: 194Examples:
169 195
170 # easy one 196 # easy one
171 my $st = sql_exec "select name, id from table where id = ?", $id; 197 my $st = sql_exec "select name, id from table where id = ?", $id;
181 sql_exec $dbh, "update file set name = ?", "oops.txt"; 207 sql_exec $dbh, "update file set name = ?", "oops.txt";
182 208
183 209
184=item sql_fetch <see sql_exec> 210=item sql_fetch <see sql_exec>
185 211
212=item sql_ufetch <see sql_uexec>
213
186Execute a sql-statement and fetch the first row of results. Depending on 214Execute an sql-statement and fetch the first row of results. Depending on
187the caller context the row will be returned as a list (array context), or 215the caller context the row will be returned as a list (array context), or
188just the first columns. In table form: 216just the first columns. In table form:
189 217
190 CONTEXT RESULT 218 CONTEXT RESULT
191 void () 219 void ()
202 230
203 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
204 232
205... and it's still quite fast unless you fetch large amounts of data. 233... and it's still quite fast unless you fetch large amounts of data.
206 234
235C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
236UTF-8 and forces all result values to UTF-8 (this does I<not> include result
237parameters, only return values. Using bind variables in conjunction with
238sql_u* functions might result in undefined behaviour - we use UTF-8 on
239bind-variables at execution time and it seems to work on DBD::mysql as it
240ignores the UTF-8 bit completely. Which just means that that DBD-driver is
241broken).
242
207=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
244
245=item sql_ufetchall <see sql_uexec>
208 246
209Similarly to C<sql_fetch>, but all result rows will be fetched (this is 247Similarly to C<sql_fetch>, but all result rows will be fetched (this is
210of course inefficient for large results!). The context is ignored (only 248of course inefficient for large results!). The context is ignored (only
211list context makes sense), but the result still depends on the number of 249list context makes sense), but the result still depends on the number of
212columns in the result: 250columns in the result:
224 262
225 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
226 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
227 } 265 }
228 266
267C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
268values to UTF-8 and forces all result values to UTF-8 (see the caveats in
269the description of C<sql_ufetch>, though).
270
229=item sql_exists "<table> where ...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
272
273=item sql_uexists <see sql_exists>
230 274
231Check wether the result of the sql-statement "select xxx from 275Check wether the result of the sql-statement "select xxx from
232$first_argument" would be empty or not (that is, imagine the string 276$first_argument" would be empty or not (that is, imagine the string
233"select from" were prepended to your statement (it isn't)). Should work 277"select * from" were prepended to your statement (it isn't)). Should work
234with every database but can be quite slow, except on mysql, where this 278with every database but can be quite slow, except on mysql, where this
235should be quite fast. 279should be quite fast.
280
281C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
282UTF-8.
236 283
237Examples: 284Examples:
238 285
239 print "user 7 exists!\n" 286 print "user 7 exists!\n"
240 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
253 300
254 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
255 postgres: C<oid> column (is there a way to get the last SERIAL?) 302 postgres: C<oid> column (is there a way to get the last SERIAL?)
256 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
257 informix: C<SERIAL> or C<SERIAL8> column of the last insert 304 informix: C<SERIAL> or C<SERIAL8> column of the last insert
305 sqlite: C<last_insert_rowid()>
258 306
259Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
260 308
261=cut 309=cut
262 310
263sub sql_insertid($) { 311sub sql_insertid($) {
264 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
265 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
266 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
267 315
268 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
269 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
270 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
271 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 319 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
320 $driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()');
272 321
273 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 322 Carp::croak "sql_insertid does not support the dbd driver '$driver', at";
274} 323}
275 324
276=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
277 326
278Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The 327Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
279default is somewhere around 50 (= the 50 last recently used statements 328default is somewhere around 50 (= the 50 last recently used statements
280will be cached). It shouldn't be too large, since a simple linear listed 329will be cached). It shouldn't be too large, since a simple linear list
281is used for the cache at the moment (which, for small (<100) cache sizes 330is used for the cache at the moment (which, for small (<100) cache sizes
282is actually quite fast). 331is actually quite fast).
283 332
284The function always returns the cache size in effect I<before> the call, 333The function always returns the cache size in effect I<before> the call,
285so, to nuke the cache (for example, when a database connection has died 334so, to nuke the cache (for example, when a database connection has died
312 361
313reinitialize; 362reinitialize;
314 363
315package PApp::SQL::Database; 364package PApp::SQL::Database;
316 365
317=head2 THE DATABASE CLASS 366=head2 The Database Class
318 367
319Again (sigh) the problem of persistency. What do you do when you have to serialize on object 368Again (sigh) the problem of persistency. What do you do when you have
320that contains (or should contain) a database handle? Short answer: you don't. Long answer: 369to serialize on object that contains (or should contain) a database
370handle? Short answer: you don't. Long answer: you can embed the necessary
321you can embed the necessary information to recreate the dbh when needed. 371information to recreate the dbh when needed.
322 372
323The C<PApp::SQL::Database> class does that, in a relatively efficient 373The C<PApp::SQL::Database> class does that, in a relatively efficient
324fashion: the overhead is currently a single method call per access (you 374fashion: the overhead is currently a single method call per access (you
325can cache the real dbh if you want). 375can cache the real dbh if you want).
326 376
359 409
360sub checked_dbh($) { 410sub checked_dbh($) {
361 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
362 $dbh && $dbh->ping 412 $dbh && $dbh->ping
363 ? $dbh 413 ? $dbh
364 : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]); 414 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
365} 415}
366 416
367=item $db->dsn 417=item $db->dsn
368 418
369Return the DSN (L<DBI>) fo the database object (e.g. for error messages). 419Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
420
421=item $db->login
422
423Return the login name.
424
425=item $db->password
426
427Return the password (emphasizing the fact that the password is stored plaintext ;)
370 428
371=cut 429=cut
372 430
373sub dsn($) { 431sub dsn($) {
374 my $self = shift; 432 my $self = shift;
375 (split /\x00/, $self->[0])[1]; 433 (split /\x00/, $self->[0])[1];
376} 434}
377 435
436sub login($) {
437 my $self = shift;
438 (split /\x00/, $self->[0])[2];
439}
440
441sub password($) {
442 my $self = shift;
443 (split /\x00/, $self->[0])[3];
444}
445
378=back 446=back
379 447
380=cut 448=cut
381 449
3821; 4501;
385 453
386L<PApp>. 454L<PApp>.
387 455
388=head1 AUTHOR 456=head1 AUTHOR
389 457
390 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
391 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
392 460
393=cut 461=cut
394 462

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines