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.31 by root, Wed Jan 28 19:58:19 2004 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.143; 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
… …
88be nice as a placeholder for the database object that corresponds to 89be nice as a placeholder for the database object that corresponds to
89$PApp::SQL::DBH. 90$PApp::SQL::DBH.
90 91
91=back 92=back
92 93
93=head2 FUNCTIONS 94=head2 Functions
94 95
95=over 4 96=over 4
96 97
97=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
98 99
… …
144 145
145 # then connect anew 146 # then connect anew
146 $dbcache{$id} = 147 $dbcache{$id} =
147 eval { DBI->connect($dsn, $user, $pass, $flags) } 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 || die "unable to connect to database $dsn: $DBI::errstr\n"; 150 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
150 $connect->($dbcache{$id}) if $connect; 151 $connect->($dbcache{$id}) if $connect;
151 } 152 }
152 $dbcache{$id}; 153 $dbcache{$id};
153} 154}
154 155
… …
299 300
300 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
301 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?)
302 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
303 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()>
304 306
305Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
306 308
307=cut 309=cut
308 310
309sub sql_insertid($) { 311sub sql_insertid($) {
310 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
311 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
312 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
313 315
314 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
315 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
316 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
317 $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 ()');
318 321
319 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";
320} 323}
321 324
322=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
323 326
324Returns (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
… …
358 361
359reinitialize; 362reinitialize;
360 363
361package PApp::SQL::Database; 364package PApp::SQL::Database;
362 365
363=head2 THE DATABASE CLASS 366=head2 The Database Class
364 367
365Again (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
366to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
367handle? 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
368information to recreate the dbh when needed. 371information to recreate the dbh when needed.
… …
406 409
407sub checked_dbh($) { 410sub checked_dbh($) {
408 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
409 $dbh && $dbh->ping 412 $dbh && $dbh->ping
410 ? $dbh 413 ? $dbh
411 : 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]);
412} 415}
413 416
414=item $db->dsn 417=item $db->dsn
415 418
416Return 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).
… …
450 453
451L<PApp>. 454L<PApp>.
452 455
453=head1 AUTHOR 456=head1 AUTHOR
454 457
455 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
456 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
457 460
458=cut 461=cut
459 462

Diff Legend

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