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.16 by root, Sun Apr 22 15:13:58 2001 UTC vs.
Revision 1.39 by root, Sun Jun 21 03:30:00 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3PApp::SQL - absolutely easy yet fast and powerful sql access 3PApp::SQL - absolutely easy yet fast and powerful sql access.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use PApp::SQL; 7 use PApp::SQL;
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.123; 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
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
123Examples: 123Examples:
124 124
125 # try your luck opening the papp database without access info 125 # try your luck opening the papp database without access info
126 $dbh = connect_cached __FILE__, "DBI:mysql:papp"; 126 $dbh = connect_cached __FILE__, "DBI:mysql:papp";
127
128Mysql-specific behaviour: The default setting of
129C<mysql_client_found_rows> is TRUE, you can overwrite this, though.
127 130
128=cut 131=cut
129 132
130sub connect_cached { 133sub connect_cached {
131 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 134 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
132 # the following line is duplicated in PApp::SQL::Database::new 135 # the following line is duplicated in PApp::SQL::Database::new
133 $id = "$id\0$dsn\0$user\0$pass"; 136 $id = "$id\0$dsn\0$user\0$pass";
134 unless ($dbcache{$id} && $dbcache{$id}->ping) { 137 unless ($dbcache{$id} && $dbcache{$id}->ping) {
135 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
136 # first, nuke our statement cache (sooory ;) 138 # first, nuke our statement cache (sooory ;)
137 cachesize cachesize 0; 139 cachesize cachesize 0;
140
141 # then make mysql behave more standardly by default
142 $dsn =~ /^[Dd][Bb][Ii]:mysql:/
143 and $dsn !~ /;mysql_client_found_rows/
144 and $dsn .= ";mysql_client_found_rows=1";
145
138 # then connect anew 146 # then connect anew
139 $dbcache{$id} = 147 $dbcache{$id} =
140 eval { DBI->connect($dsn, $user, $pass, $flags) } 148 eval { DBI->connect($dsn, $user, $pass, $flags) }
141 || eval { DBI->connect($dsn, $user, $pass, $flags) } 149 || eval { DBI->connect($dsn, $user, $pass, $flags) }
142 || die "unable to connect to database $dsn: $DBI::errstr\n"; 150 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
143 $connect->($dbcache{$id}) if $connect; 151 $connect->($dbcache{$id}) if $connect;
144 } 152 }
145 $dbcache{$id}; 153 $dbcache{$id};
146} 154}
147 155
155statement handle. The command and the statement handle will be cached 163statement handle. The command and the statement handle will be cached
156(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
157called 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
158returned 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>
159with 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
160called), 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.
161 170
162The database handle (the first argument) is optional. If it is missing, 171The database handle (the first argument) is optional. If it is missing,
163C<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
164calling) package and, if that fails, it tries to use database handle in 173before calling these functions. NOTICE: future and former versions of
165C<$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
166 185
167The 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
168package-global (and exported) variable C<$sql_exec>. 187package-global (and exported) variable C<$sql_exec>.
169 188
170If any error occurs C<sql_exec> will throw an exception. 189If any error occurs C<sql_exec> will throw an exception.
171 190
172C<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
173utf8 before calling the C<execute> method. 192UTF-8 before calling the C<execute> method.
174 193
175Examples: 194Examples:
176 195
177 # easy one 196 # easy one
178 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;
212 my($name, $amount) = sql_fetch "select ...", args... 231 my($name, $amount) = sql_fetch "select ...", args...
213 232
214... 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.
215 234
216C<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
217utf8 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).
218 242
219=item sql_fetchall <see sql_exec> 243=item sql_fetchall <see sql_exec>
220 244
221=item sql_ufetchall <see sql_uexec> 245=item sql_ufetchall <see sql_uexec>
222 246
239 for (sql_fetchall "select name, age, place from user") { 263 for (sql_fetchall "select name, age, place from user") {
240 my ($name, $age, $place) = @$_; 264 my ($name, $age, $place) = @$_;
241 } 265 }
242 266
243C<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
244values 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).
245 270
246=item sql_exists "<table> where ...", args... 271=item sql_exists "<table_references> where <where_condition>...", args...
247 272
248=item sql_uexists <see sql_exists> 273=item sql_uexists <see sql_exists>
249 274
250Check wether the result of the sql-statement "select xxx from 275Check wether the result of the sql-statement "select xxx from
251$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
252"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
253with 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
254should be quite fast. 279should be quite fast.
255 280
256C<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
257utf8. 282UTF-8.
258 283
259Examples: 284Examples:
260 285
261 print "user 7 exists!\n" 286 print "user 7 exists!\n"
262 if sql_exists "user where id = ?", 7; 287 if sql_exists "user where id = ?", 7;
275 300
276 mysql: first C<AUTO_INCREMENT> column set to NULL 301 mysql: first C<AUTO_INCREMENT> column set to NULL
277 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?)
278 sybase: C<IDENTITY> column of the last insert (slow) 303 sybase: C<IDENTITY> column of the last insert (slow)
279 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()>
280 306
281Except for sybase, this does not require a server access. 307Except for sybase, this does not require a server access.
282 308
283=cut 309=cut
284 310
285sub sql_insertid($) { 311sub sql_insertid($) {
286 my $sth = shift or die "sql_insertid requires a statement handle"; 312 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
287 my $dbh = $sth->{Database}; 313 my $dbh = $sth->{Database};
288 my $driver = $dbh->{Driver}{Name}; 314 my $driver = $dbh->{Driver}{Name};
289 315
290 $driver eq "mysql" and return $sth->{mysql_insertid}; 316 $driver eq "mysql" and return $sth->{mysql_insertid};
291 $driver eq "Pg" and return $sth->{pg_oid_status}; 317 $driver eq "Pg" and return $sth->{pg_oid_status};
292 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 318 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
293 $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 ()');
294 321
295 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";
296} 323}
297 324
298=item [old-size] = cachesize [new-size] 325=item [old-size] = cachesize [new-size]
299 326
300Returns (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
301default is somewhere around 50 (= the 50 last recently used statements 328default is somewhere around 50 (= the 50 last recently used statements
302will 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
303is 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
304is actually quite fast). 331is actually quite fast).
305 332
306The 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,
307so, 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
334 361
335reinitialize; 362reinitialize;
336 363
337package PApp::SQL::Database; 364package PApp::SQL::Database;
338 365
339=head2 THE DATABASE CLASS 366=head2 The Database Class
340 367
341Again (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
342to serialize on object that contains (or should contain) a database 369to serialize on object that contains (or should contain) a database
343handle? 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
344information to recreate the dbh when needed. 371information to recreate the dbh when needed.
382 409
383sub checked_dbh($) { 410sub checked_dbh($) {
384 my $dbh = $dbcache{$_[0][0]}; 411 my $dbh = $dbcache{$_[0][0]};
385 $dbh && $dbh->ping 412 $dbh && $dbh->ping
386 ? $dbh 413 ? $dbh
387 : 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]);
388} 415}
389 416
390=item $db->dsn 417=item $db->dsn
391 418
392Return 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).
395 422
396Return the login name. 423Return the login name.
397 424
398=item $db->password 425=item $db->password
399 426
400Return the password (emphasizing the fact that the apssword is stored plaintext ;) 427Return the password (emphasizing the fact that the password is stored plaintext ;)
401 428
402=cut 429=cut
403 430
404sub dsn($) { 431sub dsn($) {
405 my $self = shift; 432 my $self = shift;
426 453
427L<PApp>. 454L<PApp>.
428 455
429=head1 AUTHOR 456=head1 AUTHOR
430 457
431 Marc Lehmann <pcg@goof.com> 458 Marc Lehmann <schmorp@schmorp.de>
432 http://www.goof.com/pcg/marc/ 459 http://home.schmorp.de/
433 460
434=cut 461=cut
435 462

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines