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.30 by stefan, Wed Jan 28 19:50:38 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
… …
186package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
187 188
188If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
189 190
190C<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
191utf8 before calling the C<execute> method. 192UTF-8 before calling the C<execute> method.
192 193
193Examples: 194Examples:
194 195
195 # easy one 196 # easy one
196 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;
… …
230 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
231 232
232... 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.
233 234
234C<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
235utf8 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
236parameters, only return values. Using bind variables in cinjunction with 237parameters, only return values. Using bind variables in conjunction with
237sql_u* functions results in undefined behaviour - we use utf8_on on 238sql_u* functions might result in undefined behaviour - we use UTF-8 on
238bind-variables and it seems to work on DBD::mysql which just means 239bind-variables at execution time and it seems to work on DBD::mysql as it
239that that DBD-driver is broken). 240ignores the UTF-8 bit completely. Which just means that that DBD-driver is
241broken).
240 242
241=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
242 244
243=item sql_ufetchall <see sql_uexec> 245=item sql_ufetchall <see sql_uexec>
244 246
… …
261 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
262 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
263 } 265 }
264 266
265C<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
266values 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
267the description of C<sql_ufetch>, though). 269the description of C<sql_ufetch>, though).
268 270
269=item sql_exists "<table_references> where <where_condition>...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
270 272
271=item sql_uexists <see sql_exists> 273=item sql_uexists <see sql_exists>
… …
275"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
276with 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
277should be quite fast. 279should be quite fast.
278 280
279C<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
280utf8. 282UTF-8.
281 283
282Examples: 284Examples:
283 285
284 print "user 7 exists!\n" 286 print "user 7 exists!\n"
285 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
… …
298 300
299 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
300 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?)
301 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
302 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()>
303 306
304Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
305 308
306=cut 309=cut
307 310
308sub sql_insertid($) { 311sub sql_insertid($) {
309 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
310 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
311 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
312 315
313 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
314 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
315 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
316 $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 ()');
317 321
318 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";
319} 323}
320 324
321=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
322 326
323Returns (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
… …
357 361
358reinitialize; 362reinitialize;
359 363
360package PApp::SQL::Database; 364package PApp::SQL::Database;
361 365
362=head2 THE DATABASE CLASS 366=head2 The Database Class
363 367
364Again (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
365to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
366handle? 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
367information to recreate the dbh when needed. 371information to recreate the dbh when needed.
… …
405 409
406sub checked_dbh($) { 410sub checked_dbh($) {
407 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
408 $dbh && $dbh->ping 412 $dbh && $dbh->ping
409 ? $dbh 413 ? $dbh
410 : 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]);
411} 415}
412 416
413=item $db->dsn 417=item $db->dsn
414 418
415Return 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).
… …
449 453
450L<PApp>. 454L<PApp>.
451 455
452=head1 AUTHOR 456=head1 AUTHOR
453 457
454 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
455 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
456 460
457=cut 461=cut
458 462

Diff Legend

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