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.43 by root, Mon Mar 4 06:25:32 2019 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%'"
25 25
26=head1 DESCRIPTION 26=head1 DESCRIPTION
27 27
28This module provides you with easy-to-use functions to execute sql 28This module provides you with easy-to-use functions to execute sql
29commands (using DBI). Despite being easy to use, they are also quite 29commands (using DBI). Despite being easy to use, they are also quite
30efficient and allow you to write faster programs in less lines of code. It 30efficient and allow you to write faster programs in fewer lines of
31should work with anything from perl-5.004_01 onwards, but I only support 31code. It should work with anything from perl-5.004_01 onwards, but I only
325.005+. UTF8 handling (the C<sql_u*> family of functions) will only be 32support 5.005+. UTF8 handling (the C<sql_u*> family of functions) will
33effective with perl version 5.006 and beyond. 33only be effective with perl version 5.006 and beyond.
34 34
35If the descriptions here seem terse or if you always wanted to know 35If the descriptions here seem terse or if you always wanted to know
36what PApp is then have a look at the PApp module which uses this module 36what PApp is then have a look at the PApp module which uses this module
37extensively but also provides you with a lot more gimmicks to play around 37extensively but also provides you with a lot more gimmicks to play around
38with to help you create cool applications ;) 38with to help you create cool applications ;)
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 = '2.002';
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
88be nice as a placeholder for the database object that corresponds to 91be nice as a placeholder for the database object that corresponds to
89$PApp::SQL::DBH. 92$PApp::SQL::DBH.
90 93
91=back 94=back
92 95
93=head2 FUNCTIONS 96=head2 Functions
94 97
95=over 4 98=over 4
96 99
97=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 100=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
98 101
99(not exported by by default) 102(not exported by by default)
100 103
101Connect to the database given by C<($dsn,$user,$pass)>, while using the 104Connect to the database given by C<($dsn,$user,$pass)>, while using the
102flags from C<$flags>. These are just the same arguments as given to 105flags from C<$flags>. These are just the same arguments as given to
103C<DBI->connect>. 106C<< DBI->connect >>.
104 107
105The database handle will be cached under the unique id 108The database handle will be cached under the unique id
106C<$id|$dsn|$user|$pass>. If the same id is requested later, the 109C<$id|$dsn|$user|$pass>. If the same id is requested later, the
107cached handle will be checked (using ping), and the connection will 110cached handle will be checked (using ping), and the connection will
108be re-established if necessary (be sure to prefix your application or 111be re-established if necessary (be sure to prefix your application or
144 147
145 # then connect anew 148 # then connect anew
146 $dbcache{$id} = 149 $dbcache{$id} =
147 eval { DBI->connect($dsn, $user, $pass, $flags) } 150 eval { DBI->connect($dsn, $user, $pass, $flags) }
148 || eval { DBI->connect($dsn, $user, $pass, $flags) } 151 || eval { DBI->connect($dsn, $user, $pass, $flags) }
149 || die "unable to connect to database $dsn: $DBI::errstr\n"; 152 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
150 $connect->($dbcache{$id}) if $connect; 153 $connect->($dbcache{$id}) if $connect;
151 } 154 }
152 $dbcache{$id}; 155 $dbcache{$id};
153} 156}
154 157
180database handle in C<$PApp::SQL::DBH>, which you can set before calling 183database handle in C<$PApp::SQL::DBH>, which you can set before calling
181these functions. 184these functions.
182 185
183=end comment 186=end comment
184 187
185The 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
186package-global (and exported) variable C<$sql_exec>. 189the package-global (and exported) variable C<$sql_exec>.
187 190
188If any error occurs C<sql_exec> will throw an exception. 191If any error occurs C<sql_exec> will throw an exception.
189 192
190C<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
191utf8 before calling the C<execute> method. 194UTF-8 before calling the C<execute> method.
192 195
193Examples: 196Examples:
194 197
195 # easy one 198 # easy one
196 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;
230 my($name, $amount) = sql_fetch "select ...", args... 233 my($name, $amount) = sql_fetch "select ...", args...
231 234
232... 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.
233 236
234C<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
235utf8 and forces all result values to utf8 (this does I<not> include result 238UTF-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 239parameters, only return values. Using bind variables in conjunction with
237sql_u* functions results in undefined behaviour - we use utf8_on on 240sql_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 241bind-variables at execution time and it seems to work on DBD::mysql as it
239that that DBD-driver is broken). 242ignores the UTF-8 bit completely. Which just means that that DBD-driver is
243broken).
240 244
241=item sql_fetchall <see sql_exec> 245=item sql_fetchall <see sql_exec>
242 246
243=item sql_ufetchall <see sql_uexec> 247=item sql_ufetchall <see sql_uexec>
244 248
261 for (sql_fetchall "select name, age, place from user") { 265 for (sql_fetchall "select name, age, place from user") {
262 my ($name, $age, $place) = @$_; 266 my ($name, $age, $place) = @$_;
263 } 267 }
264 268
265C<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
266values to utf8 and forces all result values to utf8 (see the caveats in 270values to UTF-8 and forces all result values to UTF-8 (see the caveats in
267the description of C<sql_ufetch>, though). 271the description of C<sql_ufetch>, though).
268 272
269=item sql_exists "<table_references> where <where_condition>...", args... 273=item sql_exists "<table_references> where <where_condition>...", args...
270 274
271=item sql_uexists <see sql_exists> 275=item sql_uexists <see sql_exists>
275"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
276with 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
277should be quite fast. 281should be quite fast.
278 282
279C<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
280utf8. 284UTF-8.
281 285
282Examples: 286Examples:
283 287
284 print "user 7 exists!\n" 288 print "user 7 exists!\n"
285 if sql_exists "user where id = ?", 7; 289 if sql_exists "user where id = ?", 7;
294Returns the last automatically created key value. It must be executed 298Returns the last automatically created key value. It must be executed
295directly after executing the insert statement that created it. This is 299directly after executing the insert statement that created it. This is
296what is actually returned for various databases. If your database is 300what is actually returned for various databases. If your database is
297missing, please send me an e-mail on how to implement this ;) 301missing, please send me an e-mail on how to implement this ;)
298 302
303 mariadb: first C<AUTO_INCREMENT> column set to NULL
299 mysql: first C<AUTO_INCREMENT> column set to NULL 304 mysql: first C<AUTO_INCREMENT> column set to NULL
300 postgres: C<oid> column (is there a way to get the last SERIAL?) 305 postgres: C<oid> column (is there a way to get the last SERIAL?)
301 sybase: C<IDENTITY> column of the last insert (slow) 306 sybase: C<IDENTITY> column of the last insert (slow)
302 informix: C<SERIAL> or C<SERIAL8> column of the last insert 307 informix: C<SERIAL> or C<SERIAL8> column of the last insert
308 sqlite: C<last_insert_rowid()>
303 309
304Except for sybase, this does not require a server access. 310Except for sybase, this does not require a server access.
305 311
306=cut 312=cut
307 313
308sub sql_insertid($) { 314sub sql_insertid($) {
309 my $sth = shift or die "sql_insertid requires a statement handle"; 315 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
310 my $dbh = $sth->{Database}; 316 my $dbh = $sth->{Database};
311 my $driver = $dbh->{Driver}{Name}; 317 my $driver = $dbh->{Driver}{Name};
312 318
319 $driver eq "MariaDB" and return $sth->{mariadb_insertid};
313 $driver eq "mysql" and return $sth->{mysql_insertid}; 320 $driver eq "mysql" and return $sth->{mysql_insertid};
314 $driver eq "Pg" and return $sth->{pg_oid_status}; 321 $driver eq "Pg" and return $sth->{pg_oid_status};
315 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 322 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
316 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 323 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
324 $driver eq "SQLite" and return sql_fetch ($dbh, 'SELECT last_insert_rowid ()');
317 325
318 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 326 $dbh->last_insert_id (undef, undef, undef, undef)
319} 327}
320 328
321=item [old-size] = cachesize [new-size] 329=item [old-size] = cachesize [new-size]
322 330
323Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The 331Returns (and possibly changes) the LRU cache size used by C<sql_exec>. The
355 363
356=cut 364=cut
357 365
358reinitialize; 366reinitialize;
359 367
368=head2 Type Deduction
369
370Since every database driver seems to deduce parameter types differently,
371usually wrongly, and at leats in the case of DBD::mysql, different in
372every other release or so, and this can and does lead to data corruption,
373this module does type deduction itself.
374
375What does it mean? Simple - sql parameters for placeholders will be
376explicitly marked as SQL_VARCHAR, SQL_INTEGER or SQL_DOUBLE the first time
377a statement is prepared.
378
379To force a specific type, you can either continue to use e.g. sql casts,
380or you can make sure to consistently use strings or numbers. To make a
381perl scalar look enough like a string or a number, use this when passing
382it to sql_exec or a similar functions:
383
384 "$string" # to pass a string
385 $num+0 # to pass a number
386
387=cut
388
360package PApp::SQL::Database; 389package PApp::SQL::Database;
361 390
362=head2 THE DATABASE CLASS 391=head2 The Database Class
363 392
364Again (sigh) the problem of persistency. What do you do when you have 393Again (sigh) the problem of persistency. What do you do when you have
365to serialize on object that contains (or should contain) a database 394to serialize on object that contains (or should contain) a database
366handle? Short answer: you don't. Long answer: you can embed the necessary 395handle? Short answer: you don't. Long answer: you can embed the necessary
367information to recreate the dbh when needed. 396information to recreate the dbh when needed.
405 434
406sub checked_dbh($) { 435sub checked_dbh($) {
407 my $dbh = $dbcache{$_[0][0]}; 436 my $dbh = $dbcache{$_[0][0]};
408 $dbh && $dbh->ping 437 $dbh && $dbh->ping
409 ? $dbh 438 ? $dbh
410 : PApp::SQL::connect_cached((split /\x00/, $_[0][0]), $_[0][1], $_[0][2]); 439 : PApp::SQL::connect_cached((split /\x00/, $_[0][0], 4), $_[0][1], $_[0][2]);
411} 440}
412 441
413=item $db->dsn 442=item $db->dsn
414 443
415Return the DSN (L<DBI>) fo the database object (e.g. for error messages). 444Return the DSN (L<DBI>) fo the database object (e.g. for error messages).
449 478
450L<PApp>. 479L<PApp>.
451 480
452=head1 AUTHOR 481=head1 AUTHOR
453 482
454 Marc Lehmann <pcg@goof.com> 483 Marc Lehmann <schmorp@schmorp.de>
455 http://www.goof.com/pcg/marc/ 484 http://home.schmorp.de/
456 485
457=cut 486=cut
458 487

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines