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.19 by root, Sun Jan 13 06:09:50 2002 UTC vs.
Revision 1.41 by root, Thu Apr 11 02:20:42 2013 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 "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.1241; 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
100(not exported by by default) 102(not exported by by default)
101 103
102Connect 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
103flags 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
104C<DBI->connect>. 106C<< DBI->connect >>.
105 107
106The database handle will be cached under the unique id 108The database handle will be cached under the unique id
107C<$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
108cached handle will be checked (using ping), and the connection will 110cached handle will be checked (using ping), and the connection will
109be re-established if necessary (be sure to prefix your application or 111be re-established if necessary (be sure to prefix your application or
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
145 147
146 # then connect anew 148 # then connect anew
147 $dbcache{$id} = 149 $dbcache{$id} =
148 eval { DBI->connect($dsn, $user, $pass, $flags) } 150 eval { DBI->connect($dsn, $user, $pass, $flags) }
149 || eval { DBI->connect($dsn, $user, $pass, $flags) } 151 || eval { DBI->connect($dsn, $user, $pass, $flags) }
150 || die "unable to connect to database $dsn: $DBI::errstr\n"; 152 || Carp::croak "unable to connect to database $dsn: $DBI::errstr\n";
151 $connect->($dbcache{$id}) if $connect; 153 $connect->($dbcache{$id}) if $connect;
152 } 154 }
153 $dbcache{$id}; 155 $dbcache{$id};
154} 156}
155 157
163statement handle. The command and the statement handle will be cached 165statement handle. The command and the statement handle will be cached
164(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
165called 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
166returned 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>
167with 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
168called), 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.
169 172
170The database handle (the first argument) is optional. If it is missing, 173The database handle (the first argument) is optional. If it is missing,
171C<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
172calling) package and, if that fails, it tries to use database handle in 175before calling these functions. NOTICE: future and former versions of
173C<$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.
174 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
175The 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
176package-global (and exported) variable C<$sql_exec>. 189the package-global (and exported) variable C<$sql_exec>.
177 190
178If any error occurs C<sql_exec> will throw an exception. 191If any error occurs C<sql_exec> will throw an exception.
179 192
180C<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
181utf8 before calling the C<execute> method. 194UTF-8 before calling the C<execute> method.
182 195
183Examples: 196Examples:
184 197
185 # easy one 198 # easy one
186 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;
220 my($name, $amount) = sql_fetch "select ...", args... 233 my($name, $amount) = sql_fetch "select ...", args...
221 234
222... 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.
223 236
224C<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
225utf8 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).
226 244
227=item sql_fetchall <see sql_exec> 245=item sql_fetchall <see sql_exec>
228 246
229=item sql_ufetchall <see sql_uexec> 247=item sql_ufetchall <see sql_uexec>
230 248
247 for (sql_fetchall "select name, age, place from user") { 265 for (sql_fetchall "select name, age, place from user") {
248 my ($name, $age, $place) = @$_; 266 my ($name, $age, $place) = @$_;
249 } 267 }
250 268
251C<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
252values 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).
253 272
254=item sql_exists "<table> where ...", args... 273=item sql_exists "<table_references> where <where_condition>...", args...
255 274
256=item sql_uexists <see sql_exists> 275=item sql_uexists <see sql_exists>
257 276
258Check wether the result of the sql-statement "select xxx from 277Check wether the result of the sql-statement "select xxx from
259$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
260"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
261with 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
262should be quite fast. 281should be quite fast.
263 282
264C<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
265utf8. 284UTF-8.
266 285
267Examples: 286Examples:
268 287
269 print "user 7 exists!\n" 288 print "user 7 exists!\n"
270 if sql_exists "user where id = ?", 7; 289 if sql_exists "user where id = ?", 7;
283 302
284 mysql: first C<AUTO_INCREMENT> column set to NULL 303 mysql: first C<AUTO_INCREMENT> column set to NULL
285 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?)
286 sybase: C<IDENTITY> column of the last insert (slow) 305 sybase: C<IDENTITY> column of the last insert (slow)
287 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()>
288 308
289Except for sybase, this does not require a server access. 309Except for sybase, this does not require a server access.
290 310
291=cut 311=cut
292 312
293sub sql_insertid($) { 313sub sql_insertid($) {
294 my $sth = shift or die "sql_insertid requires a statement handle"; 314 my $sth = shift or Carp::croak "sql_insertid requires a statement handle";
295 my $dbh = $sth->{Database}; 315 my $dbh = $sth->{Database};
296 my $driver = $dbh->{Driver}{Name}; 316 my $driver = $dbh->{Driver}{Name};
297 317
298 $driver eq "mysql" and return $sth->{mysql_insertid}; 318 $driver eq "mysql" and return $sth->{mysql_insertid};
299 $driver eq "Pg" and return $sth->{pg_oid_status}; 319 $driver eq "Pg" and return $sth->{pg_oid_status};
300 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 320 $driver eq "Sybase" and return sql_fetch ($dbh, 'SELECT @@IDENTITY');
301 $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 ()');
302 323
303 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";
304} 325}
305 326
306=item [old-size] = cachesize [new-size] 327=item [old-size] = cachesize [new-size]
307 328
308Returns (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
309default is somewhere around 50 (= the 50 last recently used statements 330default is somewhere around 50 (= the 50 last recently used statements
310will 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
311is 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
312is actually quite fast). 333is actually quite fast).
313 334
314The 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,
315so, 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
340 361
341=cut 362=cut
342 363
343reinitialize; 364reinitialize;
344 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
345package PApp::SQL::Database; 387package PApp::SQL::Database;
346 388
347=head2 THE DATABASE CLASS 389=head2 The Database Class
348 390
349Again (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
350to serialize on object that contains (or should contain) a database 392to serialize on object that contains (or should contain) a database
351handle? 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
352information to recreate the dbh when needed. 394information to recreate the dbh when needed.
390 432
391sub checked_dbh($) { 433sub checked_dbh($) {
392 my $dbh = $dbcache{$_[0][0]}; 434 my $dbh = $dbcache{$_[0][0]};
393 $dbh && $dbh->ping 435 $dbh && $dbh->ping
394 ? $dbh 436 ? $dbh
395 : 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]);
396} 438}
397 439
398=item $db->dsn 440=item $db->dsn
399 441
400Return 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).
403 445
404Return the login name. 446Return the login name.
405 447
406=item $db->password 448=item $db->password
407 449
408Return the password (emphasizing the fact that the apssword is stored plaintext ;) 450Return the password (emphasizing the fact that the password is stored plaintext ;)
409 451
410=cut 452=cut
411 453
412sub dsn($) { 454sub dsn($) {
413 my $self = shift; 455 my $self = shift;
434 476
435L<PApp>. 477L<PApp>.
436 478
437=head1 AUTHOR 479=head1 AUTHOR
438 480
439 Marc Lehmann <pcg@goof.com> 481 Marc Lehmann <schmorp@schmorp.de>
440 http://www.goof.com/pcg/marc/ 482 http://home.schmorp.de/
441 483
442=cut 484=cut
443 485

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines