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.24 by root, Thu Apr 11 01:02:10 2002 UTC vs.
Revision 1.41 by root, Thu Apr 11 02:20:42 2013 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.131; 50 $VERSION = '2.0';
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(
56 ); 57 );
57 58
58 bootstrap PApp::SQL $VERSION; 59 bootstrap PApp::SQL $VERSION;
59} 60}
60 61
62boot2 DBI::SQL_VARCHAR, DBI::SQL_INTEGER, DBI::SQL_DOUBLE;
63
61our $sql_exec; # last result of sql_exec's execute call 64our $sql_exec; # last result of sql_exec's execute call
62our $DBH; # the default database handle 65our $DBH; # the default database handle
63our $Database; # the current SQL::Database object, if applicable 66our $Database; # the current SQL::Database object, if applicable
64 67
65our %dbcache; 68our %dbcache;
66 69
67=head2 GLOBAL VARIABLES 70=head2 Global Variables
68 71
69=over 4 72=over 4
70 73
71=item $sql_exec 74=item $sql_exec
72 75
88be nice as a placeholder for the database object that corresponds to 91be nice as a placeholder for the database object that corresponds to
89$PApp::SQL::DBH. 92$PApp::SQL::DBH.
90 93
91=back 94=back
92 95
93=head2 FUNCTIONS 96=head2 Functions
94 97
95=over 4 98=over 4
96 99
97=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 100=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
98 101
99(not exported by by default) 102(not exported by by default)
100 103
101Connect to the database given by C<($dsn,$user,$pass)>, while using the 104Connect to the database given by C<($dsn,$user,$pass)>, while using the
102flags from C<$flags>. These are just the same arguments as given to 105flags from C<$flags>. These are just the same arguments as given to
103C<DBI->connect>. 106C<< DBI->connect >>.
104 107
105The database handle will be cached under the unique id 108The database handle will be cached under the unique id
106C<$id|$dsn|$user|$pass>. If the same id is requested later, the 109C<$id|$dsn|$user|$pass>. If the same id is requested later, the
107cached handle will be checked (using ping), and the connection will 110cached handle will be checked (using ping), and the connection will
108be re-established if necessary (be sure to prefix your application or 111be re-established if necessary (be sure to prefix your application or
144 147
145 # then connect anew 148 # then connect anew
146 $dbcache{$id} = 149 $dbcache{$id} =
147 eval { DBI->connect($dsn, $user, $pass, $flags) } 150 eval { DBI->connect($dsn, $user, $pass, $flags) }
148 || eval { DBI->connect($dsn, $user, $pass, $flags) } 151 || eval { DBI->connect($dsn, $user, $pass, $flags) }
149 || die "unable to connect to database $dsn: $DBI::errstr\n"; 152 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
150 $connect->($dbcache{$id}) if $connect; 153 $connect->($dbcache{$id}) if $connect;
151 } 154 }
152 $dbcache{$id}; 155 $dbcache{$id};
153} 156}
154 157
180database handle in C<$PApp::SQL::DBH>, which you can set before calling 183database handle in C<$PApp::SQL::DBH>, which you can set before calling
181these functions. 184these functions.
182 185
183=end comment 186=end comment
184 187
185The actual return value from the C<$sth->execute> call is stored in the 188The actual return value from the C<< $sth->execute >> call is stored in
186package-global (and exported) variable C<$sql_exec>. 189the package-global (and exported) variable C<$sql_exec>.
187 190
188If any error occurs C<sql_exec> will throw an exception. 191If any error occurs C<sql_exec> will throw an exception.
189 192
190C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to 193C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
191utf8 before calling the C<execute> method. 194UTF-8 before calling the C<execute> method.
192 195
193Examples: 196Examples:
194 197
195 # easy one 198 # easy one
196 my $st = sql_exec "select name, id from table where id = ?", $id; 199 my $st = sql_exec "select name, id from table where id = ?", $id;
230 my($name, $amount) = sql_fetch "select ...", args... 233 my($name, $amount) = sql_fetch "select ...", args...
231 234
232... and it's still quite fast unless you fetch large amounts of data. 235... and it's still quite fast unless you fetch large amounts of data.
233 236
234C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to 237C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
235utf8 and forces all result values to utf8 (this does I<not> include result 238UTF-8 and forces all result values to UTF-8 (this does I<not> include result
236parameters, only return values. Using bind variables in cinjunction with 239parameters, only return values. Using bind variables in conjunction with
237sql_u* functions results in undefined behaviour). 240sql_u* functions might result in undefined behaviour - we use UTF-8 on
241bind-variables at execution time and it seems to work on DBD::mysql as it
242ignores the UTF-8 bit completely. Which just means that that DBD-driver is
243broken).
238 244
239=item sql_fetchall <see sql_exec> 245=item sql_fetchall <see sql_exec>
240 246
241=item sql_ufetchall <see sql_uexec> 247=item sql_ufetchall <see sql_uexec>
242 248
259 for (sql_fetchall "select name, age, place from user") { 265 for (sql_fetchall "select name, age, place from user") {
260 my ($name, $age, $place) = @$_; 266 my ($name, $age, $place) = @$_;
261 } 267 }
262 268
263C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input 269C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
264values to utf8 and forces all result values to utf8 (see the caveats in 270values to UTF-8 and forces all result values to UTF-8 (see the caveats in
265the description of C<sql_ufetch>, though). 271the description of C<sql_ufetch>, though).
266 272
267=item sql_exists "<table_references> where <where_condition>...", args... 273=item sql_exists "<table_references> where <where_condition>...", args...
268 274
269=item sql_uexists <see sql_exists> 275=item sql_uexists <see sql_exists>
273"select * from" were prepended to your statement (it isn't)). Should work 279"select * from" were prepended to your statement (it isn't)). Should work
274with every database but can be quite slow, except on mysql, where this 280with every database but can be quite slow, except on mysql, where this
275should be quite fast. 281should be quite fast.
276 282
277C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to 283C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
278utf8. 284UTF-8.
279 285
280Examples: 286Examples:
281 287
282 print "user 7 exists!\n" 288 print "user 7 exists!\n"
283 if sql_exists "user where id = ?", 7; 289 if sql_exists "user where id = ?", 7;
296 302
297 mysql: first C<AUTO_INCREMENT> column set to NULL 303 mysql: first C<AUTO_INCREMENT> column set to NULL
298 postgres: C<oid> column (is there a way to get the last SERIAL?) 304 postgres: C<oid> column (is there a way to get the last SERIAL?)
299 sybase: C<IDENTITY> column of the last insert (slow) 305 sybase: C<IDENTITY> column of the last insert (slow)
300 informix: C<SERIAL> or C<SERIAL8> column of the last insert 306 informix: C<SERIAL> or C<SERIAL8> column of the last insert
307 sqlite: C<last_insert_rowid()>
301 308
302Except for sybase, this does not require a server access. 309Except for sybase, this does not require a server access.
303 310
304=cut 311=cut
305 312
306sub sql_insertid($) { 313sub sql_insertid($) {
307 my $sth = shift or die "sql_insertid requires a statement handle"; 314 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
308 my $dbh = $sth->{Database}; 315 my $dbh = $sth->{Database};
309 my $driver = $dbh->{Driver}{Name}; 316 my $driver = $dbh->{Driver}{Name};
310 317
311 $driver eq "mysql" and return $sth->{mysql_insertid}; 318 $driver eq "mysql" and return $sth->{mysql_insertid};
312 $driver eq "Pg" and return $sth->{pg_oid_status}; 319 $driver eq "Pg" and return $sth->{pg_oid_status};
313 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 320 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
314 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 321 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
322 $driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()');
315 323
316 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 324 Carp::croak "sql_insertid does not support the dbd driver '$driver', at";
317} 325}
318 326
319=item [old-size] = cachesize [new-size] 327=item [old-size] = cachesize [new-size]
320 328
321Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The 329Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
322default is somewhere around 50 (= the 50 last recently used statements 330default is somewhere around 50 (= the 50 last recently used statements
323will be cached). It shouldn't be too large, since a simple linear listed 331will be cached). It shouldn't be too large, since a simple linear list
324is used for the cache at the moment (which, for small (<100) cache sizes 332is used for the cache at the moment (which, for small (<100) cache sizes
325is actually quite fast). 333is actually quite fast).
326 334
327The function always returns the cache size in effect I<before> the call, 335The function always returns the cache size in effect I<before> the call,
328so, to nuke the cache (for example, when a database connection has died 336so, to nuke the cache (for example, when a database connection has died
353 361
354=cut 362=cut
355 363
356reinitialize; 364reinitialize;
357 365
366=head2 Type Deduction
367
368Since every database driver seems to deduce parameter types differently,
369usually wrongly, and at leats in the case of DBD::mysql, different in
370every other release or so, and this can and does lead to data corruption,
371this module does type deduction itself.
372
373What does it mean? Simple - sql parameters for placeholders will be
374explicitly marked as SQL_VARCHAR, SQL_INTEGER or SQL_DOUBLE the first time
375a statement is prepared.
376
377To force a specific type, you can either continue to use e.g. sql casts,
378or you can make sure to consistently use strings or numbers. To make a
379perl scalar look enough like a string or a number, use this when passing
380it to sql_exec or a similar functions:
381
382 "$string" # to pass a string
383 $num+0 # to pass a number
384
385=cut
386
358package PApp::SQL::Database; 387package PApp::SQL::Database;
359 388
360=head2 THE DATABASE CLASS 389=head2 The Database Class
361 390
362Again (sigh) the problem of persistency. What do you do when you have 391Again (sigh) the problem of persistency. What do you do when you have
363to serialize on object that contains (or should contain) a database 392to serialize on object that contains (or should contain) a database
364handle? Short answer: you don't. Long answer: you can embed the necessary 393handle? Short answer: you don't. Long answer: you can embed the necessary
365information to recreate the dbh when needed. 394information to recreate the dbh when needed.
403 432
404sub checked_dbh($) { 433sub checked_dbh($) {
405 my $dbh = $dbcache{$_[0][0]}; 434 my $dbh = $dbcache{$_[0][0]};
406 $dbh && $dbh->ping 435 $dbh && $dbh->ping
407 ? $dbh 436 ? $dbh
408 : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]); 437 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
409} 438}
410 439
411=item $db->dsn 440=item $db->dsn
412 441
413Return the DSN (L<DBI>) fo the database object (e.g. for error messages). 442Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
416 445
417Return the login name. 446Return the login name.
418 447
419=item $db->password 448=item $db->password
420 449
421Return the password (emphasizing the fact that the apssword is stored plaintext ;) 450Return the password (emphasizing the fact that the password is stored plaintext ;)
422 451
423=cut 452=cut
424 453
425sub dsn($) { 454sub dsn($) {
426 my $self = shift; 455 my $self = shift;
447 476
448L<PApp>. 477L<PApp>.
449 478
450=head1 AUTHOR 479=head1 AUTHOR
451 480
452 Marc Lehmann <pcg@goof.com> 481 Marc Lehmann <schmorp@schmorp.de>
453 http://www.goof.com/pcg/marc/ 482 http://home.schmorp.de/
454 483
455=cut 484=cut
456 485

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines