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.32 by root, Thu Sep 1 08:57:28 2005 UTC vs.
Revision 1.40 by root, Mon Feb 13 05:59:55 2012 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 = 1.0; 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;
… …
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
… …
299 302
300 mysql: first C<AUTO_INCREMENT> column set to NULL 303 mysql: first C<AUTO_INCREMENT> column set to NULL
301 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?)
302 sybase: C<IDENTITY> column of the last insert (slow) 305 sybase: C<IDENTITY> column of the last insert (slow)
303 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()>
304 308
305Except for sybase, this does not require a server access. 309Except for sybase, this does not require a server access.
306 310
307=cut 311=cut
308 312
309sub sql_insertid($) { 313sub sql_insertid($) {
310 my $sth = shift or die "sql_insertid requires a statement handle"; 314 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
311 my $dbh = $sth->{Database}; 315 my $dbh = $sth->{Database};
312 my $driver = $dbh->{Driver}{Name}; 316 my $driver = $dbh->{Driver}{Name};
313 317
314 $driver eq "mysql" and return $sth->{mysql_insertid}; 318 $driver eq "mysql" and return $sth->{mysql_insertid};
315 $driver eq "Pg" and return $sth->{pg_oid_status}; 319 $driver eq "Pg" and return $sth->{pg_oid_status};
316 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 320 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
317 $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 ()');
318 323
319 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";
320} 325}
321 326
322=item [old-size] = cachesize [new-size] 327=item [old-size] = cachesize [new-size]
323 328
324Returns (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
… …
356 361
357=cut 362=cut
358 363
359reinitialize; 364reinitialize;
360 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
361package PApp::SQL::Database; 387package PApp::SQL::Database;
362 388
363=head2 The Database Class 389=head2 The Database Class
364 390
365Again (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
… …
406 432
407sub checked_dbh($) { 433sub checked_dbh($) {
408 my $dbh = $dbcache{$_[0][0]}; 434 my $dbh = $dbcache{$_[0][0]};
409 $dbh && $dbh->ping 435 $dbh && $dbh->ping
410 ? $dbh 436 ? $dbh
411 : 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]);
412} 438}
413 439
414=item $db->dsn 440=item $db->dsn
415 441
416Return 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).

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines