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.23 by root, Sun Apr 7 16:23:56 2002 UTC vs.
Revision 1.38 by root, Sat Jun 20 21:03:50 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.04';
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
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 not be in use 168called), the statement handle for the first call mustn't not be in use
169anymore, as the subsequent call will re-use the handle. 169anymore, as the subsequent call will re-use the handle.
170 170
171The database handle (the first argument) is optional. If it is missing, 171The database handle (the first argument) is optional. If it is missing,
172C<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
173calling) package and, if that fails, it tries to use database handle in 173before calling these functions. NOTICE: future and former versions of
174C<$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
175 185
176The 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
177package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
178 188
179If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
180 190
181C<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
182utf8 before calling the C<execute> method. 192UTF-8 before calling the C<execute> method.
183 193
184Examples: 194Examples:
185 195
186 # easy one 196 # easy one
187 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;
221 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
222 232
223... 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.
224 234
225C<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
226utf8 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
227parameters, only return values. Using bind variables in cinjunction with 237parameters, only return values. Using bind variables in conjunction with
228sql_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).
229 242
230=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
231 244
232=item sql_ufetchall <see sql_uexec> 245=item sql_ufetchall <see sql_uexec>
233 246
250 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
251 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
252 } 265 }
253 266
254C<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
255values 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
256the description of C<sql_ufetch>, though). 269the description of C<sql_ufetch>, though).
257 270
258=item sql_exists "<table_references> where <where_condition>...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
259 272
260=item sql_uexists <see sql_exists> 273=item sql_uexists <see sql_exists>
264"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
265with 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
266should be quite fast. 279should be quite fast.
267 280
268C<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
269utf8. 282UTF-8.
270 283
271Examples: 284Examples:
272 285
273 print "user 7 exists!\n" 286 print "user 7 exists!\n"
274 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
287 300
288 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
289 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?)
290 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
291 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()>
292 306
293Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
294 308
295=cut 309=cut
296 310
297sub sql_insertid($) { 311sub sql_insertid($) {
298 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
299 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
300 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
301 315
302 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
303 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
304 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
305 $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 ()');
306 321
307 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";
308} 323}
309 324
310=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
311 326
312Returns (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
313default is somewhere around 50 (= the 50 last recently used statements 328default is somewhere around 50 (= the 50 last recently used statements
314will 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
315is 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
316is actually quite fast). 331is actually quite fast).
317 332
318The 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,
319so, 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
346 361
347reinitialize; 362reinitialize;
348 363
349package PApp::SQL::Database; 364package PApp::SQL::Database;
350 365
351=head2 THE DATABASE CLASS 366=head2 The Database Class
352 367
353Again (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
354to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
355handle? 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
356information to recreate the dbh when needed. 371information to recreate the dbh when needed.
394 409
395sub checked_dbh($) { 410sub checked_dbh($) {
396 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
397 $dbh && $dbh->ping 412 $dbh && $dbh->ping
398 ? $dbh 413 ? $dbh
399 : 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]);
400} 415}
401 416
402=item $db->dsn 417=item $db->dsn
403 418
404Return 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).
407 422
408Return the login name. 423Return the login name.
409 424
410=item $db->password 425=item $db->password
411 426
412Return the password (emphasizing the fact that the apssword is stored plaintext ;) 427Return the password (emphasizing the fact that the password is stored plaintext ;)
413 428
414=cut 429=cut
415 430
416sub dsn($) { 431sub dsn($) {
417 my $self = shift; 432 my $self = shift;
438 453
439L<PApp>. 454L<PApp>.
440 455
441=head1 AUTHOR 456=head1 AUTHOR
442 457
443 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
444 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
445 460
446=cut 461=cut
447 462

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines