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.22 by root, Sun Apr 7 16:22:56 2002 UTC vs.
Revision 1.39 by root, Sun Jun 21 03:30:00 2009 UTC

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 "table where name like 'a%'" 18 sql_exists "table where name like 'a%'"
39 39
40=cut 40=cut
41 41
42package PApp::SQL; 42package PApp::SQL;
43 43
44use Carp ();
44use DBI (); 45use DBI ();
45 46
46BEGIN { 47BEGIN {
47 use base qw(Exporter DynaLoader); 48 use base qw(Exporter DynaLoader);
48 49
49 $VERSION = 0.13; 50 $VERSION = '1.05';
50 @EXPORT = qw( 51 @EXPORT = qw(
51 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
52 sql_uexec sql_ufetch sql_ufetchall sql_uexists 53 sql_uexec sql_ufetch sql_ufetchall sql_uexists
53 ); 54 );
54 @EXPORT_OK = qw( 55 @EXPORT_OK = qw(
62our $DBH; # the default database handle 63our $DBH; # the default database handle
63our $Database; # the current SQL::Database object, if applicable 64our $Database; # the current SQL::Database object, if applicable
64 65
65our %dbcache; 66our %dbcache;
66 67
67=head2 GLOBAL VARIABLES 68=head2 Global Variables
68 69
69=over 4 70=over 4
70 71
71=item $sql_exec 72=item $sql_exec
72 73
76done by this module. 77done by this module.
77 78
78=item $PApp::SQL::DBH 79=item $PApp::SQL::DBH
79 80
80The 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
81specified as argument and no C<$DBH> is found in the current package. See 82specified as argument. See C<sql_exec> for a discussion.
82C<sql_exec> for a discussion.
83 83
84=item $PApp::SQL::Database 84=item $PApp::SQL::Database
85 85
86The current default C<PApp::SQL::Database>-object. Future versions might 86The current default C<PApp::SQL::Database>-object. Future versions might
87automatically fall back on this database and create database handles from 87automatically fall back on this database and create database handles from
89be nice as a placeholder for the database object that corresponds to 89be nice as a placeholder for the database object that corresponds to
90$PApp::SQL::DBH. 90$PApp::SQL::DBH.
91 91
92=back 92=back
93 93
94=head2 FUNCTIONS 94=head2 Functions
95 95
96=over 4 96=over 4
97 97
98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
99 99
145 145
146 # then connect anew 146 # then connect anew
147 $dbcache{$id} = 147 $dbcache{$id} =
148 eval { DBI->connect($dsn, $user, $pass, $flags) } 148 eval { DBI->connect($dsn, $user, $pass, $flags) }
149 || eval { DBI->connect($dsn, $user, $pass, $flags) } 149 || eval { DBI->connect($dsn, $user, $pass, $flags) }
150 || die "unable to connect to database $dsn: $DBI::errstr\n"; 150 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
151 $connect->($dbcache{$id}) if $connect; 151 $connect->($dbcache{$id}) if $connect;
152 } 152 }
153 $dbcache{$id}; 153 $dbcache{$id};
154} 154}
155 155
163statement handle. The command and the statement handle will be cached 163statement handle. The command and the statement handle will be cached
164(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
165called 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
166returned 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>
167with 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
168called), 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.
169 170
170The database handle (the first argument) is optional. If it is missing, 171The database handle (the first argument) is optional. If it is missing,
171C<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
172calling) package and, if that fails, it tries to use database handle in 173before calling these functions. NOTICE: future and former versions of
173C<$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
174 185
175The 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
176package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
177 188
178If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
179 190
180C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to 191C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
181utf8 before calling the C<execute> method. 192UTF-8 before calling the C<execute> method.
182 193
183Examples: 194Examples:
184 195
185 # easy one 196 # easy one
186 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;
220 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
221 232
222... 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.
223 234
224C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to 235C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
225utf8 and forces all result values to utf8 (this does I<not> include result 236UTF-8 and forces all result values to UTF-8 (this does I<not> include result
226parameters, only return values. Using bind variables in cinjunction with 237parameters, only return values. Using bind variables in conjunction with
227sql_u* functions results in undefined behaviour). 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).
228 242
229=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
230 244
231=item sql_ufetchall <see sql_uexec> 245=item sql_ufetchall <see sql_uexec>
232 246
249 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
250 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
251 } 265 }
252 266
253C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input 267C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
254values to utf8 and forces all result values to utf8 (see the caveats in 268values to UTF-8 and forces all result values to UTF-8 (see the caveats in
255the description of C<sql_ufetch>, though). 269the description of C<sql_ufetch>, though).
256 270
257=item sql_exists "<table_references> where <where_condition>...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
258 272
259=item sql_uexists <see sql_exists> 273=item sql_uexists <see sql_exists>
263"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
264with 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
265should be quite fast. 279should be quite fast.
266 280
267C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to 281C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
268utf8. 282UTF-8.
269 283
270Examples: 284Examples:
271 285
272 print "user 7 exists!\n" 286 print "user 7 exists!\n"
273 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
286 300
287 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
288 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?)
289 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
290 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()>
291 306
292Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
293 308
294=cut 309=cut
295 310
296sub sql_insertid($) { 311sub sql_insertid($) {
297 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
298 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
299 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
300 315
301 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
302 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
303 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
304 $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 ()');
305 321
306 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";
307} 323}
308 324
309=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
310 326
311Returns (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
312default is somewhere around 50 (= the 50 last recently used statements 328default is somewhere around 50 (= the 50 last recently used statements
313will 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
314is 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
315is actually quite fast). 331is actually quite fast).
316 332
317The 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,
318so, 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
345 361
346reinitialize; 362reinitialize;
347 363
348package PApp::SQL::Database; 364package PApp::SQL::Database;
349 365
350=head2 THE DATABASE CLASS 366=head2 The Database Class
351 367
352Again (sigh) the problem of persistency. What do you do when you have 368Again (sigh) the problem of persistency. What do you do when you have
353to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
354handle? Short answer: you don't. Long answer: you can embed the necessary 370handle? Short answer: you don't. Long answer: you can embed the necessary
355information to recreate the dbh when needed. 371information to recreate the dbh when needed.
393 409
394sub checked_dbh($) { 410sub checked_dbh($) {
395 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
396 $dbh && $dbh->ping 412 $dbh && $dbh->ping
397 ? $dbh 413 ? $dbh
398 : 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]);
399} 415}
400 416
401=item $db->dsn 417=item $db->dsn
402 418
403Return 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).
406 422
407Return the login name. 423Return the login name.
408 424
409=item $db->password 425=item $db->password
410 426
411Return the password (emphasizing the fact that the apssword is stored plaintext ;) 427Return the password (emphasizing the fact that the password is stored plaintext ;)
412 428
413=cut 429=cut
414 430
415sub dsn($) { 431sub dsn($) {
416 my $self = shift; 432 my $self = shift;
437 453
438L<PApp>. 454L<PApp>.
439 455
440=head1 AUTHOR 456=head1 AUTHOR
441 457
442 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
443 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
444 460
445=cut 461=cut
446 462

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines