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.19 by root, Sun Jan 13 06:09:50 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 "name from table where name like 'a%'" 18 sql_exists "table where name like 'a%'"
19 or die "a* required but not existent"; 19 or die "a* required but not existent";
20 20
21 my $db = new PApp::SQL::Database "", "DBI:mysql:test", "user", "pass"; 21 my $db = new PApp::SQL::Database "", "DBI:mysql:test", "user", "pass";
22 local $PApp::SQL::DBH = $db->checked_dbh; # does 'ping' 22 local $PApp::SQL::DBH = $db->checked_dbh; # does 'ping'
23 23
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.1241; 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
73Since the C<sql_exec> family of functions return a statement handle there 74Since the C<sql_exec> family of functions return a statement handle there
74must eb another way to test the return value of the C<execute> call. This 75must be another way to test the return value of the C<execute> call. This
75global variable contains the result of the most recent call to C<execute> 76global variable contains the result of the most recent call to C<execute>
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
111__LINE__ work fine as well). 111__LINE__ work fine as well).
112 112
113The reason C<$id> is necessary is that you might specify special connect 113The reason C<$id> is necessary is that you might specify special connect
114arguments or special flags, or you might want to configure your $DBH 114arguments or special flags, or you might want to configure your $DBH
115differently than maybe other applications requesting the same database 115differently than maybe other applications requesting the same database
116connection. If none of this is becessary for your application you can 116connection. If none of this is necessary for your application you can
117leave $id empty (i.e. ""). 117leave C<$id> empty (i.e. "").
118 118
119If specified, C<$connect> is a callback (e.g. a coderef) that will be 119If specified, C<$connect> is a callback (e.g. a coderef) that will be
120called each time a new connection is being established, with the new 120called each time a new connection is being established, with the new
121C<$dbh> as first argument. 121C<$dbh> as first argument.
122 122
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
163statement handle. The command and the statement handle will be cached 163statement handle. The command and the statement handle will be cached
164(with the database handle and the sql string as key), so prepare will be 164(with the database handle and the sql string as key), so prepare will be
165called only once for each distinct sql call (please keep in mind that the 165called only once for each distinct sql call (please keep in mind that the
166returned statement will always be the same, so, if you call C<sql_exec> 166returned statement will always be the same, so, if you call C<sql_exec>
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 be used. 168called), the statement handle for the first call mustn't not be in use
169anymore, as the subsequent call will re-use the handle.
169 170
170The database handle (the first argument) is optional. If it is missing, 171The database handle (the first argument) is optional. If it is missing,
171C<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
172calling) package and, if that fails, it tries to use database handle in 173before calling these functions. NOTICE: future and former versions of
173C<$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
174 185
175The 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
176package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
177 188
178If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
179 190
180C<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
181utf8 before calling the C<execute> method. 192UTF-8 before calling the C<execute> method.
182 193
183Examples: 194Examples:
184 195
185 # easy one 196 # easy one
186 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;
220 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
221 232
222... 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.
223 234
224C<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
225utf8 and forces all result values to utf8. 236UTF-8 and forces all result values to UTF-8 (this does I<not> include result
237parameters, only return values. Using bind variables in conjunction with
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).
226 242
227=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
228 244
229=item sql_ufetchall <see sql_uexec> 245=item sql_ufetchall <see sql_uexec>
230 246
247 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
248 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
249 } 265 }
250 266
251C<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
252values to utf8 and forces all result values to utf8. 268values to UTF-8 and forces all result values to UTF-8 (see the caveats in
269the description of C<sql_ufetch>, though).
253 270
254=item sql_exists "<table> where ...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
255 272
256=item sql_uexists <see sql_exists> 273=item sql_uexists <see sql_exists>
257 274
258Check wether the result of the sql-statement "select xxx from 275Check wether the result of the sql-statement "select xxx from
259$first_argument" would be empty or not (that is, imagine the string 276$first_argument" would be empty or not (that is, imagine the string
260"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
261with 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
262should be quite fast. 279should be quite fast.
263 280
264C<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
265utf8. 282UTF-8.
266 283
267Examples: 284Examples:
268 285
269 print "user 7 exists!\n" 286 print "user 7 exists!\n"
270 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
283 300
284 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
285 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?)
286 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
287 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()>
288 306
289Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
290 308
291=cut 309=cut
292 310
293sub sql_insertid($) { 311sub sql_insertid($) {
294 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
295 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
296 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
297 315
298 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
299 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
300 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
301 $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 ()');
302 321
303 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";
304} 323}
305 324
306=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
307 326
308Returns (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
309default is somewhere around 50 (= the 50 last recently used statements 328default is somewhere around 50 (= the 50 last recently used statements
310will 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
311is 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
312is actually quite fast). 331is actually quite fast).
313 332
314The 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,
315so, 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
342 361
343reinitialize; 362reinitialize;
344 363
345package PApp::SQL::Database; 364package PApp::SQL::Database;
346 365
347=head2 THE DATABASE CLASS 366=head2 The Database Class
348 367
349Again (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
350to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
351handle? 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
352information to recreate the dbh when needed. 371information to recreate the dbh when needed.
390 409
391sub checked_dbh($) { 410sub checked_dbh($) {
392 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
393 $dbh && $dbh->ping 412 $dbh && $dbh->ping
394 ? $dbh 413 ? $dbh
395 : 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]);
396} 415}
397 416
398=item $db->dsn 417=item $db->dsn
399 418
400Return 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).
403 422
404Return the login name. 423Return the login name.
405 424
406=item $db->password 425=item $db->password
407 426
408Return the password (emphasizing the fact that the apssword is stored plaintext ;) 427Return the password (emphasizing the fact that the password is stored plaintext ;)
409 428
410=cut 429=cut
411 430
412sub dsn($) { 431sub dsn($) {
413 my $self = shift; 432 my $self = shift;
434 453
435L<PApp>. 454L<PApp>.
436 455
437=head1 AUTHOR 456=head1 AUTHOR
438 457
439 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
440 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
441 460
442=cut 461=cut
443 462

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines