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.4 by root, Sun Nov 26 21:04:22 2000 UTC vs.
Revision 1.9 by root, Sat Feb 3 17:48:02 2001 UTC

… …
50 50
51Connect to the database given by C<($dsn,$user,$pass)>, while using the 51Connect to the database given by C<($dsn,$user,$pass)>, while using the
52flags from C<$flags>. These are just the same arguments as given to 52flags from C<$flags>. These are just the same arguments as given to
53C<DBI->connect>. 53C<DBI->connect>.
54 54
55The database handle will be cached under the unique id C<$id>. If the same 55The database handle will be cached under the unique id
56id is requested later, the cached handle will be checked (using ping), and 56C<$id|$dsn|$user|$pass>. If the same id is requested later, the
57cached handle will be checked (using ping), and the connection will
57the connection will be re-established if necessary (be sure to prefix your 58be re-established if necessary (be sure to prefix your application or
58application or module name to the id to make it "more" unique. Things like 59module name to the id to make it "more" unique. Things like __PACKAGE__ .
59__PACKAGE__ . __LINE__ work fine as well). 60__LINE__ work fine as well).
61
62The reason C<$id> is necessary is that you might specify special connect
63arguments or special flags, or you might want to configure your $DBH
64differently than maybe other applications requesting the same database
65connection. If none of this is becessary for your application you can
66leave $id empty (i.e. "").
60 67
61If specified, C<$connect> is a callback (e.g. a coderef) that will be 68If specified, C<$connect> is a callback (e.g. a coderef) that will be
62called each time a new connection is being established, with the new 69called each time a new connection is being established, with the new
63C<$dbh> as first argument. 70C<$dbh> as first argument.
64 71
… …
73 my ($id, $dsn, $user, $pass, $flags, $connect) = @_; 80 my ($id, $dsn, $user, $pass, $flags, $connect) = @_;
74 # the following line is duplicated in PApp::SQL::Database::new 81 # the following line is duplicated in PApp::SQL::Database::new
75 $id = "$id\0$dsn\0$user\0$pass"; 82 $id = "$id\0$dsn\0$user\0$pass";
76 unless ($dbcache{$id} && $dbcache{$id}->ping) { 83 unless ($dbcache{$id} && $dbcache{$id}->ping) {
77 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d# 84 #warn "connecting to ($dsn|$user|$pass|$flags)\n";#d#
78 # first, nuke our cache (sooory ;) 85 # first, nuke our statement cache (sooory ;)
79 cachesize cachesize 0; 86 cachesize cachesize 0;
80 # then connect anew 87 # then connect anew
81 $dbcache{$id} = 88 $dbcache{$id} =
82 eval { DBI->connect($dsn, $user, $pass, $flags) } 89 eval { DBI->connect($dsn, $user, $pass, $flags) }
83 || eval { DBI->connect($dsn, $user, $pass, $flags) } 90 || eval { DBI->connect($dsn, $user, $pass, $flags) }
84 || die "$DBI::errstr\n"; 91 || die "unable to connect to database $dsn: $DBI::errstr\n";
85 $connect->($dbcache{$id}) if $connect; 92 $connect->($dbcache{$id}) if $connect;
86 } 93 }
87 $dbcache{$id}; 94 $dbcache{$id};
88} 95}
89 96
… …
188 195
189=cut 196=cut
190 197
191=item $lastid = sql_insertid $sth 198=item $lastid = sql_insertid $sth
192 199
193Returns the last automatically created key value (e.g. for mysql 200Returns the last automatically created key value. It must be executed
194AUTO_INCREMENT or sybase IDENTITY fields). It must be executed directly
195after executing the insert statement that created it. 201directly after executing the insert statement that created it. This is
202what is actually returned for various databases. If your database is
203missing, please send me an e-mail on how to implement this ;)
204
205 mysql: first C<AUTO_INCREMENT> column set to NULL
206 postgres: C<oid> column (is there a way to get the last SERIAL?)
207 sybase: C<IDENTITY> column of the last insert (slow)
208 informix: C<SERIAL> or C<SERIAL8> column of the last insert
209
210Except for sybase, this does not require a server access.
196 211
197=cut 212=cut
198 213
199sub sql_insertid($) { 214sub sql_insertid($) {
200 my $sth = shift or die "sql_insertid requires a statement handle"; 215 my $sth = shift or die "sql_insertid requires a statement handle";
201 my $dbh = $sth->{Database}; 216 my $dbh = $sth->{Database};
202 my $driver = $dbh->{Driver}{Name}; 217 my $driver = $dbh->{Driver}{Name};
203 218
204 $driver eq "mysql" and return $sth->{mysql_insertid}; 219 $driver eq "mysql" and return $sth->{mysql_insertid};
220 $driver eq "Pg" and return $sth->{pg_oid_status};
205 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY'); 221 $driver eq "Sybase" and return sql_fetch($dbh, 'SELECT @@IDENTITY');
206 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1]; 222 $driver eq "Informix" and return $sth->{ix_sqlerrd}[1];
207 223
208 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid"; 224 die "sql_insertid does not spport the dbd driver '$driver', please see PApp::SQL::sql_insertid";
209} 225}
210 226
… …
225 241
226=cut 242=cut
227 243
228=item reinitialize [not exported] 244=item reinitialize [not exported]
229 245
230Clears any internal caches (statement cache, database handle cache). 246Clears any internal caches (statement cache, database handle
247cache). Should be called after C<fork> and other accidents that invalidate
248database handles.
231 249
232=cut 250=cut
233 251
234sub reinitialize { 252sub reinitialize {
235 cachesize cachesize 0; 253 cachesize cachesize 0;
… …
241 259
242=back 260=back
243 261
244=cut 262=cut
245 263
264reinitialize;
265
246package PApp::SQL::Database; 266package PApp::SQL::Database;
247 267
248=head2 THE DATABASE CLASS 268=head2 THE DATABASE CLASS
249 269
250Again (sigh) the problem of persistency. What do you do when you have to serialize on object 270Again (sigh) the problem of persistency. What do you do when you have to serialize on object
… …
301 321
302=cut 322=cut
303 323
304sub dsn($) { 324sub dsn($) {
305 my $self = shift; 325 my $self = shift;
306 $self->[1][1]; 326 (split /\x00/, $self->[0])[1];
307} 327}
308 328
309=back 329=back
310 330
311=cut 331=cut
312
313reinitialize;
314 332
3151; 3331;
316 334
317=head1 BUGS 335=head1 BUGS
318 336

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines