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.17 by root, Sat Aug 11 02:46:16 2001 UTC vs.
Revision 1.37 by root, Sat Jan 19 07:38:52 2008 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
44use DBI (); 44use DBI ();
45 45
46BEGIN { 46BEGIN {
47 use base qw(Exporter DynaLoader); 47 use base qw(Exporter DynaLoader);
48 48
49 $VERSION = 0.124; 49 $VERSION = '1.03';
50 @EXPORT = qw( 50 @EXPORT = qw(
51 sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec 51 sql_exec sql_fetch sql_fetchall sql_exists sql_insertid $sql_exec
52 sql_uexec sql_ufetch sql_ufetchall sql_uexists 52 sql_uexec sql_ufetch sql_ufetchall sql_uexists
53 ); 53 );
54 @EXPORT_OK = qw( 54 @EXPORT_OK = qw(
62our $DBH; # the default database handle 62our $DBH; # the default database handle
63our $Database; # the current SQL::Database object, if applicable 63our $Database; # the current SQL::Database object, if applicable
64 64
65our %dbcache; 65our %dbcache;
66 66
67=head2 GLOBAL VARIABLES 67=head2 Global Variables
68 68
69=over 4 69=over 4
70 70
71=item $sql_exec 71=item $sql_exec
72 72
73Since the C<sql_exec> family of functions return a statement handle there 73Since 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 74must 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> 75global variable contains the result of the most recent call to C<execute>
76done by this module. 76done by this module.
77 77
78=item $PApp::SQL::DBH 78=item $PApp::SQL::DBH
79 79
80The default database handle used by this module if no C<$DBH> was 80The 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 81specified as argument. See C<sql_exec> for a discussion.
82C<sql_exec> for a discussion.
83 82
84=item $PApp::SQL::Database 83=item $PApp::SQL::Database
85 84
86The current default C<PApp::SQL::Database>-object. Future versions might 85The current default C<PApp::SQL::Database>-object. Future versions might
87automatically fall back on this database and create database handles from 86automatically fall back on this database and create database handles from
89be nice as a placeholder for the database object that corresponds to 88be nice as a placeholder for the database object that corresponds to
90$PApp::SQL::DBH. 89$PApp::SQL::DBH.
91 90
92=back 91=back
93 92
94=head2 FUNCTIONS 93=head2 Functions
95 94
96=over 4 95=over 4
97 96
98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 97=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
99 98
111__LINE__ work fine as well). 110__LINE__ work fine as well).
112 111
113The reason C<$id> is necessary is that you might specify special connect 112The reason C<$id> is necessary is that you might specify special connect
114arguments or special flags, or you might want to configure your $DBH 113arguments or special flags, or you might want to configure your $DBH
115differently than maybe other applications requesting the same database 114differently than maybe other applications requesting the same database
116connection. If none of this is becessary for your application you can 115connection. If none of this is necessary for your application you can
117leave $id empty (i.e. ""). 116leave C<$id> empty (i.e. "").
118 117
119If specified, C<$connect> is a callback (e.g. a coderef) that will be 118If 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 119called each time a new connection is being established, with the new
121C<$dbh> as first argument. 120C<$dbh> as first argument.
122 121
123Examples: 122Examples:
124 123
125 # try your luck opening the papp database without access info 124 # try your luck opening the papp database without access info
126 $dbh = connect_cached __FILE__, "DBI:mysql:papp"; 125 $dbh = connect_cached __FILE__, "DBI:mysql:papp";
126
127Mysql-specific behaviour: The default setting of
128C<mysql_client_found_rows> is TRUE, you can overwrite this, though.
127 129
128=cut 130=cut
129 131
130sub connect_cached { 132sub connect_cached {
131 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 133 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
132 # the following line is duplicated in PApp::SQL::Database::new 134 # the following line is duplicated in PApp::SQL::Database::new
133 $id = "$id\0$dsn\0$user\0$pass"; 135 $id = "$id\0$dsn\0$user\0$pass";
134 unless ($dbcache{$id} && $dbcache{$id}->ping) { 136 unless ($dbcache{$id} && $dbcache{$id}->ping) {
135 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
136 # first, nuke our statement cache (sooory ;) 137 # first, nuke our statement cache (sooory ;)
137 cachesize cachesize 0; 138 cachesize cachesize 0;
139
140 # then make mysql behave more standardly by default
141 $dsn =~ /^[Dd][Bb][Ii]:mysql:/
142 and $dsn !~ /;mysql_client_found_rows/
143 and $dsn .= ";mysql_client_found_rows=1";
144
138 # then connect anew 145 # then connect anew
139 $dbcache{$id} = 146 $dbcache{$id} =
140 eval { DBI->connect($dsn, $user, $pass, $flags) } 147 eval { DBI->connect($dsn, $user, $pass, $flags) }
141 || eval { DBI->connect($dsn, $user, $pass, $flags) } 148 || eval { DBI->connect($dsn, $user, $pass, $flags) }
142 || die "unable to connect to database $dsn: $DBI::errstr\n"; 149 || die "unable to connect to database $dsn: $DBI::errstr\n";
155statement handle. The command and the statement handle will be cached 162statement 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 163(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 164called 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> 165returned 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 166with 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. 167called), the statement handle for the first call mustn't not be in use
168anymore, as the subsequent call will re-use the handle.
161 169
162The database handle (the first argument) is optional. If it is missing, 170The 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 (= 171it 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 172before calling these functions. NOTICE: future and former versions of
165C<$PApp::SQL::DBH>, which you can set before calling these functions. 173PApp::SQL might also look up the global variable C<$DBH> in the callers
174package.
175
176=begin comment
177
178If it is missing, C<sql_exec> first tries to use the variable C<$DBH>
179in the current (= calling) package and, if that fails, it tries to use
180database handle in C<$PApp::SQL::DBH>, which you can set before calling
181these functions.
182
183=end comment
166 184
167The actual return value from the C<$sth->execute> call is stored in the 185The actual return value from the C<$sth->execute> call is stored in the
168package-global (and exported) variable C<$sql_exec>. 186package-global (and exported) variable C<$sql_exec>.
169 187
170If any error occurs C<sql_exec> will throw an exception. 188If any error occurs C<sql_exec> will throw an exception.
171 189
172C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to 190C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
173utf8 before calling the C<execute> method. 191UTF-8 before calling the C<execute> method.
174 192
175Examples: 193Examples:
176 194
177 # easy one 195 # easy one
178 my $st = sql_exec "select name, id from table where id = ?", $id; 196 my $st = sql_exec "select name, id from table where id = ?", $id;
212 my($name, $amount) = sql_fetch "select ...", args... 230 my($name, $amount) = sql_fetch "select ...", args...
213 231
214... and it's still quite fast unless you fetch large amounts of data. 232... and it's still quite fast unless you fetch large amounts of data.
215 233
216C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to 234C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
217utf8 and forces all result values to utf8. 235UTF-8 and forces all result values to UTF-8 (this does I<not> include result
236parameters, only return values. Using bind variables in conjunction with
237sql_u* functions might result in undefined behaviour - we use UTF-8 on
238bind-variables at execution time and it seems to work on DBD::mysql as it
239ignores the UTF-8 bit completely. Which just means that that DBD-driver is
240broken).
218 241
219=item sql_fetchall <see sql_exec> 242=item sql_fetchall <see sql_exec>
220 243
221=item sql_ufetchall <see sql_uexec> 244=item sql_ufetchall <see sql_uexec>
222 245
239 for (sql_fetchall "select name, age, place from user") { 262 for (sql_fetchall "select name, age, place from user") {
240 my ($name, $age, $place) = @$_; 263 my ($name, $age, $place) = @$_;
241 } 264 }
242 265
243C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input 266C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
244values to utf8 and forces all result values to utf8. 267values to UTF-8 and forces all result values to UTF-8 (see the caveats in
268the description of C<sql_ufetch>, though).
245 269
246=item sql_exists "<table> where ...", args... 270=item sql_exists "<table_references> where <where_condition>...", args...
247 271
248=item sql_uexists <see sql_exists> 272=item sql_uexists <see sql_exists>
249 273
250Check wether the result of the sql-statement "select xxx from 274Check wether the result of the sql-statement "select xxx from
251$first_argument" would be empty or not (that is, imagine the string 275$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 276"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 277with every database but can be quite slow, except on mysql, where this
254should be quite fast. 278should be quite fast.
255 279
256C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to 280C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
257utf8. 281UTF-8.
258 282
259Examples: 283Examples:
260 284
261 print "user 7 exists!\n" 285 print "user 7 exists!\n"
262 if sql_exists "user where id = ?", 7; 286 if sql_exists "user where id = ?", 7;
275 299
276 mysql: first C<AUTO_INCREMENT> column set to NULL 300 mysql: first C<AUTO_INCREMENT> column set to NULL
277 postgres: C<oid> column (is there a way to get the last SERIAL?) 301 postgres: C<oid> column (is there a way to get the last SERIAL?)
278 sybase: C<IDENTITY> column of the last insert (slow) 302 sybase: C<IDENTITY> column of the last insert (slow)
279 informix: C<SERIAL> or C<SERIAL8> column of the last insert 303 informix: C<SERIAL> or C<SERIAL8> column of the last insert
304 sqlite: C<last_insert_rowid()>
280 305
281Except for sybase, this does not require a server access. 306Except for sybase, this does not require a server access.
282 307
283=cut 308=cut
284 309
289 314
290 $driver eq "mysql" and return $sth->{mysql_insertid}; 315 $driver eq "mysql" and return $sth->{mysql_insertid};
291 $driver eq "Pg" and return $sth->{pg_oid_status}; 316 $driver eq "Pg" and return $sth->{pg_oid_status};
292 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 317 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY');
293 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 318 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
319 $driver eq "SQLite" and return sql_fetch($dbh, 'SELECT last_insert_rowid ()');
294 320
295 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 321 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid";
296} 322}
297 323
298=item [old-size] = cachesize [new-size] 324=item [old-size] = cachesize [new-size]
299 325
300Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The 326Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
301default is somewhere around 50 (= the 50 last recently used statements 327default is somewhere around 50 (= the 50 last recently used statements
302will be cached). It shouldn't be too large, since a simple linear listed 328will 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 329is used for the cache at the moment (which, for small (<100) cache sizes
304is actually quite fast). 330is actually quite fast).
305 331
306The function always returns the cache size in effect I<before> the call, 332The 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 333so, to nuke the cache (for example, when a database connection has died
334 360
335reinitialize; 361reinitialize;
336 362
337package PApp::SQL::Database; 363package PApp::SQL::Database;
338 364
339=head2 THE DATABASE CLASS 365=head2 The Database Class
340 366
341Again (sigh) the problem of persistency. What do you do when you have 367Again (sigh) the problem of persistency. What do you do when you have
342to serialize on object that contains (or should contain) a database 368to serialize on object that contains (or should contain) a database
343handle? Short answer: you don't. Long answer: you can embed the necessary 369handle? Short answer: you don't. Long answer: you can embed the necessary
344information to recreate the dbh when needed. 370information to recreate the dbh when needed.
382 408
383sub checked_dbh($) { 409sub checked_dbh($) {
384 my $dbh = $dbcache{$_[0][0]}; 410 my $dbh = $dbcache{$_[0][0]};
385 $dbh && $dbh->ping 411 $dbh && $dbh->ping
386 ? $dbh 412 ? $dbh
387 : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]); 413 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
388} 414}
389 415
390=item $db->dsn 416=item $db->dsn
391 417
392Return the DSN (L<DBI>) fo the database object (e.g. for error messages). 418Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
395 421
396Return the login name. 422Return the login name.
397 423
398=item $db->password 424=item $db->password
399 425
400Return the password (emphasizing the fact that the apssword is stored plaintext ;) 426Return the password (emphasizing the fact that the password is stored plaintext ;)
401 427
402=cut 428=cut
403 429
404sub dsn($) { 430sub dsn($) {
405 my $self = shift; 431 my $self = shift;
426 452
427L<PApp>. 453L<PApp>.
428 454
429=head1 AUTHOR 455=head1 AUTHOR
430 456
431 Marc Lehmann <pcg@goof.com> 457 Marc Lehmann <schmorp@schmorp.de>
432 http://www.goof.com/pcg/marc/ 458 http://home.schmorp.de/
433 459
434=cut 460=cut
435 461

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines