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.11 by root, Sat Feb 10 01:28:26 2001 UTC vs.
Revision 1.43 by root, Mon Mar 4 06:25:32 2019 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
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+. 32support 5.005+. UTF8 handling (the C<sql_u*> family of functions) will
33only be effective with perl version 5.006 and beyond.
33 34
34If 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
35what 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
36extensively 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
37with to help you create cool applications ;) 38with to help you create cool applications ;)
38 39
39=cut 40=cut
40 41
41package PApp::SQL; 42package PApp::SQL;
42 43
44use Carp ();
43use DBI (); 45use DBI ();
44 46
45BEGIN { 47BEGIN {
46 use base qw(Exporter DynaLoader); 48 use base qw(Exporter DynaLoader);
47 49
48 $VERSION = 0.12; 50 $VERSION = '2.002';
49 @EXPORT = qw( 51 @EXPORT = qw(
50 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
53 sql_uexec sql_ufetch sql_ufetchall sql_uexists
51 ); 54 );
52 @EXPORT_OK = qw( 55 @EXPORT_OK = qw(
53 connect_cached 56 connect_cached
54 ); 57 );
55 58
56 bootstrap PApp::SQL $VERSION; 59 bootstrap PApp::SQL $VERSION;
57} 60}
58 61
62boot2 DBI::SQL_VARCHAR, DBI::SQL_INTEGER, DBI::SQL_DOUBLE;
63
59our $sql_exec; # last result of sql_exec's execute call 64our $sql_exec; # last result of sql_exec's execute call
60our $DBH; # the default database handle 65our $DBH; # the default database handle
61our $Database; # the current SQL::Database object, if applicable 66our $Database; # the current SQL::Database object, if applicable
62 67
63our %dbcache; 68our %dbcache;
64 69
65=head2 GLOBAL VARIABLES 70=head2 Global Variables
66 71
67=over 4 72=over 4
68 73
69=item $sql_exec 74=item $sql_exec
70 75
71Since 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
72must 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
73global 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>
74done by this module. 79done by this module.
75 80
76=item $PApp::SQL::DBH 81=item $PApp::SQL::DBH
77 82
78The 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
79specified as argument and no C<$DBH> is found in the current package. See 84specified as argument. See C<sql_exec> for a discussion.
80C<sql_exec> for a discussion.
81 85
82=item $PApp::SQL::Database 86=item $PApp::SQL::Database
83 87
84The current default C<PApp::SQL::Database>-object. Future versions might 88The current default C<PApp::SQL::Database>-object. Future versions might
85automatically fall back on this database and create database handles from 89automatically fall back on this database and create database handles from
87be nice as a placeholder for the database object that corresponds to 91be nice as a placeholder for the database object that corresponds to
88$PApp::SQL::DBH. 92$PApp::SQL::DBH.
89 93
90=back 94=back
91 95
92=head2 FUNCTIONS 96=head2 Functions
93 97
94=over 4 98=over 4
95 99
96=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect 100=item $dbh = connect_cached $id, $dsn, $user, $pass, $flags, $connect
97 101
98(not exported by by default) 102(not exported by by default)
99 103
100Connect 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
101flags 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
102C<DBI->connect>. 106C<< DBI->connect >>.
103 107
104The database handle will be cached under the unique id 108The database handle will be cached under the unique id
105C<$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
106cached handle will be checked (using ping), and the connection will 110cached handle will be checked (using ping), and the connection will
107be re-established if necessary (be sure to prefix your application or 111be re-established if necessary (be sure to prefix your application or
109__LINE__ work fine as well). 113__LINE__ work fine as well).
110 114
111The 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
112arguments or special flags, or you might want to configure your $DBH 116arguments or special flags, or you might want to configure your $DBH
113differently than maybe other applications requesting the same database 117differently than maybe other applications requesting the same database
114connection. If none of this is becessary for your application you can 118connection. If none of this is necessary for your application you can
115leave $id empty (i.e. ""). 119leave C<$id> empty (i.e. "").
116 120
117If 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
118called each time a new connection is being established, with the new 122called each time a new connection is being established, with the new
119C<$dbh> as first argument. 123C<$dbh> as first argument.
120 124
121Examples: 125Examples:
122 126
123 # try your luck opening the papp database without access info 127 # try your luck opening the papp database without access info
124 $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.
125 132
126=cut 133=cut
127 134
128sub connect_cached { 135sub connect_cached {
129 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 136 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
130 # the following line is duplicated in PApp::SQL::Database::new 137 # the following line is duplicated in PApp::SQL::Database::new
131 $id = "$id\0$dsn\0$user\0$pass"; 138 $id = "$id\0$dsn\0$user\0$pass";
132 unless ($dbcache{$id} && $dbcache{$id}->ping) { 139 unless ($dbcache{$id} && $dbcache{$id}->ping) {
133 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
134 # first, nuke our statement cache (sooory ;) 140 # first, nuke our statement cache (sooory ;)
135 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
136 # then connect anew 148 # then connect anew
137 $dbcache{$id} = 149 $dbcache{$id} =
138 eval { DBI->connect($dsn, $user, $pass, $flags) } 150 eval { DBI->connect($dsn, $user, $pass, $flags) }
139 || eval { DBI->connect($dsn, $user, $pass, $flags) } 151 || eval { DBI->connect($dsn, $user, $pass, $flags) }
140 || die "unable to connect to database $dsn: $DBI::errstr\n"; 152 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
141 $connect->($dbcache{$id}) if $connect; 153 $connect->($dbcache{$id}) if $connect;
142 } 154 }
143 $dbcache{$id}; 155 $dbcache{$id};
144} 156}
145 157
146=item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...] 158=item $sth = sql_exec [dbh,] [bind-vals...,] "sql-statement", [arguments...]
159
160=item $sth = sql_uexec <see sql_exec>
147 161
148C<sql_exec> is the most important and most-used function in this module. 162C<sql_exec> is the most important and most-used function in this module.
149 163
150Runs the given sql command with the given parameters and returns the 164Runs the given sql command with the given parameters and returns the
151statement handle. The command and the statement handle will be cached 165statement handle. The command and the statement handle will be cached
152(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
153called 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
154returned 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>
155with 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
156called), 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.
157 172
158The database handle (the first argument) is optional. If it is missing, 173The database handle (the first argument) is optional. If it is missing,
159C<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
160calling) package and, if that fails, it tries to use database handle in 175before calling these functions. NOTICE: future and former versions of
161C<$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.
162 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
187
163The 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
164package-global (and exported) variable C<$sql_exec>. 189the package-global (and exported) variable C<$sql_exec>.
165 190
166If any error occurs C<sql_exec> will throw an exception. 191If any error occurs C<sql_exec> will throw an exception.
192
193C<sql_uexec> is similar to C<sql_exec> but upgrades all input arguments to
194UTF-8 before calling the C<execute> method.
167 195
168Examples: 196Examples:
169 197
170 # easy one 198 # easy one
171 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;
181 sql_exec $dbh, "update file set name = ?", "oops.txt"; 209 sql_exec $dbh, "update file set name = ?", "oops.txt";
182 210
183 211
184=item sql_fetch <see sql_exec> 212=item sql_fetch <see sql_exec>
185 213
214=item sql_ufetch <see sql_uexec>
215
186Execute a sql-statement and fetch the first row of results. Depending on 216Execute an sql-statement and fetch the first row of results. Depending on
187the caller context the row will be returned as a list (array context), or 217the caller context the row will be returned as a list (array context), or
188just the first columns. In table form: 218just the first columns. In table form:
189 219
190 CONTEXT RESULT 220 CONTEXT RESULT
191 void () 221 void ()
202 232
203 my($name, $amount) = sql_fetch "select ...", args... 233 my($name, $amount) = sql_fetch "select ...", args...
204 234
205... 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.
206 236
237C<sql_ufetch> is similar to C<sql_fetch> but upgrades all input values to
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).
244
207=item sql_fetchall <see sql_exec> 245=item sql_fetchall <see sql_exec>
246
247=item sql_ufetchall <see sql_uexec>
208 248
209Similarly to C<sql_fetch>, but all result rows will be fetched (this is 249Similarly to C<sql_fetch>, but all result rows will be fetched (this is
210of course inefficient for large results!). The context is ignored (only 250of course inefficient for large results!). The context is ignored (only
211list context makes sense), but the result still depends on the number of 251list context makes sense), but the result still depends on the number of
212columns in the result: 252columns in the result:
224 264
225 for (sql_fetchall "select name, age, place from user") { 265 for (sql_fetchall "select name, age, place from user") {
226 my ($name, $age, $place) = @$_; 266 my ($name, $age, $place) = @$_;
227 } 267 }
228 268
269C<sql_ufetchall> is similar to C<sql_fetchall> but upgrades all input
270values to UTF-8 and forces all result values to UTF-8 (see the caveats in
271the description of C<sql_ufetch>, though).
272
229=item sql_exists "<table> where ...", args... 273=item sql_exists "<table_references> where <where_condition>...", args...
274
275=item sql_uexists <see sql_exists>
230 276
231Check wether the result of the sql-statement "select xxx from 277Check wether the result of the sql-statement "select xxx from
232$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
233"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
234with 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
235should be quite fast. 281should be quite fast.
282
283C<sql_uexists> is similar to C<sql_exists> but upgrades all parameters to
284UTF-8.
236 285
237Examples: 286Examples:
238 287
239 print "user 7 exists!\n" 288 print "user 7 exists!\n"
240 if sql_exists "user where id = ?", 7; 289 if sql_exists "user where id = ?", 7;
249Returns the last automatically created key value. It must be executed 298Returns the last automatically created key value. It must be executed
250directly after executing the insert statement that created it. This is 299directly after executing the insert statement that created it. This is
251what is actually returned for various databases. If your database is 300what is actually returned for various databases. If your database is
252missing, please send me an e-mail on how to implement this ;) 301missing, please send me an e-mail on how to implement this ;)
253 302
303 mariadb: first C<AUTO_INCREMENT> column set to NULL
254 mysql: first C<AUTO_INCREMENT> column set to NULL 304 mysql: first C<AUTO_INCREMENT> column set to NULL
255 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?)
256 sybase: C<IDENTITY> column of the last insert (slow) 306 sybase: C<IDENTITY> column of the last insert (slow)
257 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()>
258 309
259Except for sybase, this does not require a server access. 310Except for sybase, this does not require a server access.
260 311
261=cut 312=cut
262 313
263sub sql_insertid($) { 314sub sql_insertid($) {
264 my $sth = shift or die "sql_insertid requires a statement handle"; 315 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
265 my $dbh = $sth->{Database}; 316 my $dbh = $sth->{Database};
266 my $driver = $dbh->{Driver}{Name}; 317 my $driver = $dbh->{Driver}{Name};
267 318
319 $driver eq "MariaDB" and return $sth->{mariadb_insertid};
268 $driver eq "mysql" and return $sth->{mysql_insertid}; 320 $driver eq "mysql" and return $sth->{mysql_insertid};
269 $driver eq "Pg" and return $sth->{pg_oid_status}; 321 $driver eq "Pg" and return $sth->{pg_oid_status};
270 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 322 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
271 $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 ()');
272 325
273 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)
274} 327}
275 328
276=item [old-size] = cachesize [new-size] 329=item [old-size] = cachesize [new-size]
277 330
278Returns (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
279default is somewhere around 50 (= the 50 last recently used statements 332default is somewhere around 50 (= the 50 last recently used statements
280will be cached). It shouldn't be too large, since a simple linear listed 333will be cached). It shouldn't be too large, since a simple linear list
281is used for the cache at the moment (which, for small (<100) cache sizes 334is used for the cache at the moment (which, for small (<100) cache sizes
282is actually quite fast). 335is actually quite fast).
283 336
284The function always returns the cache size in effect I<before> the call, 337The function always returns the cache size in effect I<before> the call,
285so, to nuke the cache (for example, when a database connection has died 338so, to nuke the cache (for example, when a database connection has died
310 363
311=cut 364=cut
312 365
313reinitialize; 366reinitialize;
314 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
315package PApp::SQL::Database; 389package PApp::SQL::Database;
316 390
317=head2 THE DATABASE CLASS 391=head2 The Database Class
318 392
319Again (sigh) the problem of persistency. What do you do when you have to serialize on object 393Again (sigh) the problem of persistency. What do you do when you have
320that contains (or should contain) a database handle? Short answer: you don't. Long answer: 394to serialize on object that contains (or should contain) a database
395handle? Short answer: you don't. Long answer: you can embed the necessary
321you can embed the necessary information to recreate the dbh when needed. 396information to recreate the dbh when needed.
322 397
323The C<PApp::SQL::Database> class does that, in a relatively efficient 398The C<PApp::SQL::Database> class does that, in a relatively efficient
324fashion: the overhead is currently a single method call per access (you 399fashion: the overhead is currently a single method call per access (you
325can cache the real dbh if you want). 400can cache the real dbh if you want).
326 401
359 434
360sub checked_dbh($) { 435sub checked_dbh($) {
361 my $dbh = $dbcache{$_[0][0]}; 436 my $dbh = $dbcache{$_[0][0]};
362 $dbh && $dbh->ping 437 $dbh && $dbh->ping
363 ? $dbh 438 ? $dbh
364 : 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]);
365} 440}
366 441
367=item $db->dsn 442=item $db->dsn
368 443
369Return 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).
445
446=item $db->login
447
448Return the login name.
449
450=item $db->password
451
452Return the password (emphasizing the fact that the password is stored plaintext ;)
370 453
371=cut 454=cut
372 455
373sub dsn($) { 456sub dsn($) {
374 my $self = shift; 457 my $self = shift;
375 (split /\x00/, $self->[0])[1]; 458 (split /\x00/, $self->[0])[1];
376} 459}
377 460
461sub login($) {
462 my $self = shift;
463 (split /\x00/, $self->[0])[2];
464}
465
466sub password($) {
467 my $self = shift;
468 (split /\x00/, $self->[0])[3];
469}
470
378=back 471=back
379 472
380=cut 473=cut
381 474
3821; 4751;
385 478
386L<PApp>. 479L<PApp>.
387 480
388=head1 AUTHOR 481=head1 AUTHOR
389 482
390 Marc Lehmann <pcg@goof.com> 483 Marc Lehmann <schmorp@schmorp.de>
391 http://www.goof.com/pcg/marc/ 484 http://home.schmorp.de/
392 485
393=cut 486=cut
394 487

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines