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.40 by root, Mon Feb 13 05:59:55 2012 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.124; 50 $VERSION = '2.0';
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(
56 ); 57 );
57 58
58 bootstrap PApp::SQL $VERSION; 59 bootstrap PApp::SQL $VERSION;
59} 60}
60 61
62boot2 DBI::SQL_VARCHAR, DBI::SQL_INTEGER, DBI::SQL_DOUBLE;
63
61our $sql_exec; # last result of sql_exec's execute call 64our $sql_exec; # last result of sql_exec's execute call
62our $DBH; # the default database handle 65our $DBH; # the default database handle
63our $Database; # the current SQL::Database object, if applicable 66our $Database; # the current SQL::Database object, if applicable
64 67
65our %dbcache; 68our %dbcache;
66 69
67=head2 GLOBAL VARIABLES 70=head2 Global Variables
68 71
69=over 4 72=over 4
70 73
71=item $sql_exec 74=item $sql_exec
72 75
73Since the C<sql_exec> family of functions return a statement handle there 76Since 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 77must 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> 78global variable contains the result of the most recent call to C<execute>
76done by this module. 79done by this module.
77 80
78=item $PApp::SQL::DBH 81=item $PApp::SQL::DBH
79 82
80The default database handle used by this module if no C<$DBH> was 83The 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 84specified as argument. See C<sql_exec> for a discussion.
82C<sql_exec> for a discussion.
83 85
84=item $PApp::SQL::Database 86=item $PApp::SQL::Database
85 87
86The current default C<PApp::SQL::Database>-object. Future versions might 88The current default C<PApp::SQL::Database>-object. Future versions might
87automatically fall back on this database and create database handles from 89automatically fall back on this database and create database handles from
89be nice as a placeholder for the database object that corresponds to 91be nice as a placeholder for the database object that corresponds to
90$PApp::SQL::DBH. 92$PApp::SQL::DBH.
91 93
92=back 94=back
93 95
94=head2 FUNCTIONS 96=head2 Functions
95 97
96=over 4 98=over 4
97 99
98=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 100=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
99 101
111__LINE__ work fine as well). 113__LINE__ work fine as well).
112 114
113The reason C<$id> is necessary is that you might specify special connect 115The reason C<$id> is necessary is that you might specify special connect
114arguments or special flags, or you might want to configure your $DBH 116arguments or special flags, or you might want to configure your $DBH
115differently than maybe other applications requesting the same database 117differently than maybe other applications requesting the same database
116connection. If none of this is becessary for your application you can 118connection. If none of this is necessary for your application you can
117leave $id empty (i.e. ""). 119leave C<$id> empty (i.e. "").
118 120
119If specified, C<$connect> is a callback (e.g. a coderef) that will be 121If 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 122called each time a new connection is being established, with the new
121C<$dbh> as first argument. 123C<$dbh> as first argument.
122 124
123Examples: 125Examples:
124 126
125 # try your luck opening the papp database without access info 127 # try your luck opening the papp database without access info
126 $dbh = connect_cached __FILE__, "DBI:mysql:papp"; 128 $dbh = connect_cached __FILE__, "DBI:mysql:papp";
129
130Mysql-specific behaviour: The default setting of
131C<mysql_client_found_rows> is TRUE, you can overwrite this, though.
127 132
128=cut 133=cut
129 134
130sub connect_cached { 135sub connect_cached {
131 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 136 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
132 # the following line is duplicated in PApp::SQL::Database::new 137 # the following line is duplicated in PApp::SQL::Database::new
133 $id = "$id\0$dsn\0$user\0$pass"; 138 $id = "$id\0$dsn\0$user\0$pass";
134 unless ($dbcache{$id} && $dbcache{$id}->ping) { 139 unless ($dbcache{$id} && $dbcache{$id}->ping) {
135 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
136 # first, nuke our statement cache (sooory ;) 140 # first, nuke our statement cache (sooory ;)
137 cachesize cachesize 0; 141 cachesize cachesize 0;
142
143 # then make mysql behave more standardly by default
144 $dsn =~ /^[Dd][Bb][Ii]:mysql:/
145 and $dsn !~ /;mysql_client_found_rows/
146 and $dsn .= ";mysql_client_found_rows=1";
147
138 # then connect anew 148 # then connect anew
139 $dbcache{$id} = 149 $dbcache{$id} =
140 eval { DBI->connect($dsn, $user, $pass, $flags) } 150 eval { DBI->connect($dsn, $user, $pass, $flags) }
141 || eval { DBI->connect($dsn, $user, $pass, $flags) } 151 || eval { DBI->connect($dsn, $user, $pass, $flags) }
142 || die "unable to connect to database $dsn: $DBI::errstr\n"; 152 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
143 $connect->($dbcache{$id}) if $connect; 153 $connect->($dbcache{$id}) if $connect;
144 } 154 }
145 $dbcache{$id}; 155 $dbcache{$id};
146} 156}
147 157
155statement handle. The command and the statement handle will be cached 165statement 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 166(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 167called 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> 168returned 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 169with 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. 170called), the statement handle for the first call mustn't not be in use
171anymore, as the subsequent call will re-use the handle.
161 172
162The database handle (the first argument) is optional. If it is missing, 173The 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 (= 174it 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 175before calling these functions. NOTICE: future and former versions of
165C<$PApp::SQL::DBH>, which you can set before calling these functions. 176PApp::SQL might also look up the global variable C<$DBH> in the callers
177package.
178
179=begin comment
180
181If it is missing, C<sql_exec> first tries to use the variable C<$DBH>
182in the current (= calling) package and, if that fails, it tries to use
183database handle in C<$PApp::SQL::DBH>, which you can set before calling
184these functions.
185
186=end comment
166 187
167The actual return value from the C<$sth->execute> call is stored in the 188The actual return value from the C<$sth->execute> call is stored in the
168package-global (and exported) variable C<$sql_exec>. 189package-global (and exported) variable C<$sql_exec>.
169 190
170If any error occurs C<sql_exec> will throw an exception. 191If any error occurs C<sql_exec> will throw an exception.
171 192
172C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to 193C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
173utf8 before calling the C<execute> method. 194UTF-8 before calling the C<execute> method.
174 195
175Examples: 196Examples:
176 197
177 # easy one 198 # easy one
178 my $st = sql_exec "select name, id from table where id = ?", $id; 199 my $st = sql_exec "select name, id from table where id = ?", $id;
212 my($name, $amount) = sql_fetch "select ...", args... 233 my($name, $amount) = sql_fetch "select ...", args...
213 234
214... and it's still quite fast unless you fetch large amounts of data. 235... and it's still quite fast unless you fetch large amounts of data.
215 236
216C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to 237C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
217utf8 and forces all result values to utf8. 238UTF-8 and forces all result values to UTF-8 (this does I<not> include result
239parameters, only return values. Using bind variables in conjunction with
240sql_u* functions might result in undefined behaviour - we use UTF-8 on
241bind-variables at execution time and it seems to work on DBD::mysql as it
242ignores the UTF-8 bit completely. Which just means that that DBD-driver is
243broken).
218 244
219=item sql_fetchall <see sql_exec> 245=item sql_fetchall <see sql_exec>
220 246
221=item sql_ufetchall <see sql_uexec> 247=item sql_ufetchall <see sql_uexec>
222 248
239 for (sql_fetchall "select name, age, place from user") { 265 for (sql_fetchall "select name, age, place from user") {
240 my ($name, $age, $place) = @$_; 266 my ($name, $age, $place) = @$_;
241 } 267 }
242 268
243C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input 269C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
244values to utf8 and forces all result values to utf8. 270values to UTF-8 and forces all result values to UTF-8 (see the caveats in
271the description of C<sql_ufetch>, though).
245 272
246=item sql_exists "<table> where ...", args... 273=item sql_exists "<table_references> where <where_condition>...", args...
247 274
248=item sql_uexists <see sql_exists> 275=item sql_uexists <see sql_exists>
249 276
250Check wether the result of the sql-statement "select xxx from 277Check wether the result of the sql-statement "select xxx from
251$first_argument" would be empty or not (that is, imagine the string 278$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 279"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 280with every database but can be quite slow, except on mysql, where this
254should be quite fast. 281should be quite fast.
255 282
256C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to 283C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
257utf8. 284UTF-8.
258 285
259Examples: 286Examples:
260 287
261 print "user 7 exists!\n" 288 print "user 7 exists!\n"
262 if sql_exists "user where id = ?", 7; 289 if sql_exists "user where id = ?", 7;
275 302
276 mysql: first C<AUTO_INCREMENT> column set to NULL 303 mysql: first C<AUTO_INCREMENT> column set to NULL
277 postgres: C<oid> column (is there a way to get the last SERIAL?) 304 postgres: C<oid> column (is there a way to get the last SERIAL?)
278 sybase: C<IDENTITY> column of the last insert (slow) 305 sybase: C<IDENTITY> column of the last insert (slow)
279 informix: C<SERIAL> or C<SERIAL8> column of the last insert 306 informix: C<SERIAL> or C<SERIAL8> column of the last insert
307 sqlite: C<last_insert_rowid()>
280 308
281Except for sybase, this does not require a server access. 309Except for sybase, this does not require a server access.
282 310
283=cut 311=cut
284 312
285sub sql_insertid($) { 313sub sql_insertid($) {
286 my $sth = shift or die "sql_insertid requires a statement handle"; 314 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
287 my $dbh = $sth->{Database}; 315 my $dbh = $sth->{Database};
288 my $driver = $dbh->{Driver}{Name}; 316 my $driver = $dbh->{Driver}{Name};
289 317
290 $driver eq "mysql" and return $sth->{mysql_insertid}; 318 $driver eq "mysql" and return $sth->{mysql_insertid};
291 $driver eq "Pg" and return $sth->{pg_oid_status}; 319 $driver eq "Pg" and return $sth->{pg_oid_status};
292 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 320 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
293 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 321 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
322 $driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()');
294 323
295 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 324 Carp::croak "sql_insertid does not support the dbd driver '$driver', at";
296} 325}
297 326
298=item [old-size] = cachesize [new-size] 327=item [old-size] = cachesize [new-size]
299 328
300Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The 329Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
301default is somewhere around 50 (= the 50 last recently used statements 330default is somewhere around 50 (= the 50 last recently used statements
302will be cached). It shouldn't be too large, since a simple linear listed 331will 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 332is used for the cache at the moment (which, for small (<100) cache sizes
304is actually quite fast). 333is actually quite fast).
305 334
306The function always returns the cache size in effect I<before> the call, 335The 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 336so, to nuke the cache (for example, when a database connection has died
332 361
333=cut 362=cut
334 363
335reinitialize; 364reinitialize;
336 365
366=head2 Type Deduction
367
368Since every database driver seems to deduce parameter types differently,
369usually wrongly, and at leats in the case of DBD::mysql, different in
370every other release or so, and this can and does lead to data corruption,
371this module does type deduction itself.
372
373What does it mean? Simple - sql parameters for placeholders will be
374explicitly marked as SQL_VARCHAR, SQL_INTEGER or SQL_DOUBLE the first time
375a statement is prepared.
376
377To force a specific type, you can either continue to use e.g. sql casts,
378or you can make sure to consistently use strings or numbers. To make a
379perl scalar look enough like a string or a number, use this when passing
380it to sql_exec or a similar functions:
381
382 "$string" # to pass a string
383 $num+0 # to pass a number
384
385=cut
386
337package PApp::SQL::Database; 387package PApp::SQL::Database;
338 388
339=head2 THE DATABASE CLASS 389=head2 The Database Class
340 390
341Again (sigh) the problem of persistency. What do you do when you have 391Again (sigh) the problem of persistency. What do you do when you have
342to serialize on object that contains (or should contain) a database 392to serialize on object that contains (or should contain) a database
343handle? Short answer: you don't. Long answer: you can embed the necessary 393handle? Short answer: you don't. Long answer: you can embed the necessary
344information to recreate the dbh when needed. 394information to recreate the dbh when needed.
382 432
383sub checked_dbh($) { 433sub checked_dbh($) {
384 my $dbh = $dbcache{$_[0][0]}; 434 my $dbh = $dbcache{$_[0][0]};
385 $dbh && $dbh->ping 435 $dbh && $dbh->ping
386 ? $dbh 436 ? $dbh
387 : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]); 437 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
388} 438}
389 439
390=item $db->dsn 440=item $db->dsn
391 441
392Return the DSN (L<DBI>) fo the database object (e.g. for error messages). 442Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
395 445
396Return the login name. 446Return the login name.
397 447
398=item $db->password 448=item $db->password
399 449
400Return the password (emphasizing the fact that the apssword is stored plaintext ;) 450Return the password (emphasizing the fact that the password is stored plaintext ;)
401 451
402=cut 452=cut
403 453
404sub dsn($) { 454sub dsn($) {
405 my $self = shift; 455 my $self = shift;
426 476
427L<PApp>. 477L<PApp>.
428 478
429=head1 AUTHOR 479=head1 AUTHOR
430 480
431 Marc Lehmann <pcg@goof.com> 481 Marc Lehmann <schmorp@schmorp.de>
432 http://www.goof.com/pcg/marc/ 482 http://home.schmorp.de/
433 483
434=cut 484=cut
435 485

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines