Author: timbo
Date: Sun Feb 1 02:28:40 2004
New Revision: 44
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/DBIXS.h
dbi/trunk/META.yml
dbi/trunk/Makefile.PL
dbi/trunk/README
dbi/trunk/ToDo
dbi/trunk/lib/DBD/ExampleP.pm
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/t/05thrclone.t
dbi/trunk/t/30subclass.t
Log:
Changes for DBI-1.39
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Sun Feb 1 02:28:40 2004
@@ -17,6 +17,33 @@
=head1 CHANGES
+=head2 Changes in DBI 1.39, 27th November 2003
+
+ Fixed STORE to not clear error during nested DBI call, again/better,
+ thanks to Tony Bowden for the report and helpful test case.
+ Fixed DBI dispatch to not try to use AUTOLOAD for driver methods unless
+ the method has been declared (as methods should be when using AUTOLOAD).
+ This fixes a problem when the Attribute::Handlers module is loaded.
+ Fixed cwd check code to use $Config{path_sep} thanks to Steve Hay.
+ Fixed unqualified croak() calls thanks to Steffen Goeldner.
+ Fixed DBD::ExampleP TYPE and PRECISION attributes thanks to Tom Lowery.
+ Fixed tracing of methods that only get traced at high trace levels.
+
+ The level 1 trace no longer includes nested method calls so it generally
+ just shows the methods the application explicitly calls.
+ Added line to trace log (level>=4) when err/errstr is cleared.
+ Updated docs for InactiveDestroy and point out where and when the
+ trace includes the process id.
+ Update DBI::DBD docs thanks to Steffen Goeldner.
+ Removed docs saying that the DBI->data_sources method could be
+ passed a $dbh. The $dbh->data_sources method should be used instead.
+ Added link to 'DBI recipes' thanks to Giuseppe Maxia:
+ http://gmax.oltrelinux.com/dbirecipes.html (note that this
+ is not an endorsement that the recipies are 'optimal')
+
+ Note: There is a bug in perl 5.8.2 when configured with threads
+ and debugging enabled (bug #24463) which causes a DBI test to fail.
+
=head2 Changes in DBI 1.38, 21th August 2003
NOTE: The DBI now requires perl version 5.6.0 or later.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sun Feb 1 02:28:40 2004
@@ -1,4 +1,4 @@
-# $Id: DBI.pm,v 11.36 2003/08/22 21:23:39 timbo Exp $
+# $Id: DBI.pm,v 11.40 2003/11/27 23:29:06 timbo Exp $
# vim: ts=8:sw=4
#
# Copyright (c) 1994-2003 Tim Bunce Ireland
@@ -6,10 +6,10 @@
# See COPYRIGHT section in pod text below for usage and distribution rights.
#
-require 5.005_03;
+require 5.006_00;
BEGIN {
-$DBI::VERSION = "1.38"; # ==> ALSO update the version in the pod text below!
+$DBI::VERSION = "1.39"; # ==> ALSO update the version in the pod text below!
}
=head1 NAME
@@ -21,7 +21,7 @@
use DBI;
@driver_names = DBI->available_drivers;
- @data_sources = DBI->data_sources($driver_name, \%attr, $dbh);
+ @data_sources = DBI->data_sources($driver_name, \%attr);
$dbh = DBI->connect($data_source, $username, $auth, \%attr);
@@ -79,33 +79,31 @@
$rc = $dbh->disconnect;
-I<This synopsis above only lists the major methods.>
+I<The synopsis above only lists the major methods and parameters.>
=head2 GETTING HELP
If you have questions about DBI, you can get help from
the I<[EMAIL PROTECTED]> mailing list.
-You can get help on subscribing and using the list by emailing:
+You can get help on subscribing and using the list by emailing
+I<[EMAIL PROTECTED]>.
- [EMAIL PROTECTED]
-
-Also worth a visit is the DBI home page at:
+(To help you make the best use of the dbi-users mailing list,
+and any other lists or forums you may use, I I<strongly>
+recommend that you read "How To Ask Questions The Smart Way"
+by Eric Raymond: L<http://www.catb.org/~esr/faqs/smart-questions.html>.)
- http://dbi.perl.org/
+The DBI home page at L<http://dbi.perl.org/> is always worth a visit
+and includes an FAQ and links to other resources.
Before asking any questions, reread this document, consult the
archives and read the DBI FAQ. The archives are listed
at the end of this document and on the DBI home page.
-The FAQ is installed as a L<DBI::FAQ> module so
+An FAQ is installed as a L<DBI::FAQ> module so
you can read it by executing C<perldoc DBI::FAQ>.
-
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I strongly
-recommend that you read "How To Ask Questions The Smart Way"
-by Eric Raymond:
-
- http://www.catb.org/~esr/faqs/smart-questions.html
+However the DBI::FAQ module is currently (2003) outdated relative
+to the online FAQ on the DBI home page.
This document often uses terms like I<references>, I<objects>,
I<methods>. If you're not familar with those terms then it would
@@ -121,8 +119,8 @@
=head2 NOTES
-This is the DBI specification that corresponds to the DBI version 1.34
-(C<$Date: 2003/08/22 21:23:39 $>).
+This is the DBI specification that corresponds to the DBI version 1.39
+(C<$Date: 2003/11/27 23:29:06 $>).
The DBI is evolving at a steady pace, so it's good to check that
you have the latest copy.
@@ -141,10 +139,10 @@
text with the version number of the DBI release they first appeared in.
Extensions to the DBI API often use the C<DBIx::*> namespace.
-See L</Naming Conventions and Name Space> and:
-
- http://search.cpan.org/search?mode=module&query=DBIx%3A%3A
- http://search.cpan.org/search?query=DBI&mode=all
+See L</Naming Conventions and Name Space>. DBI extension modules
+can be found at L<"http://search.cpan.org/search?mode=module&query=DBIx%3A%3A";>.
+And all modules related to the DBI can be found at
+L<"http://search.cpan.org/search?query=DBI&mode=all";>.
=cut
@@ -153,9 +151,9 @@
package DBI;
-my $Revision = substr(q$Revision: 11.36 $, 10);
+my $Revision = substr(q$Revision: 11.40 $, 10);
-use Carp;
+use Carp();
use DynaLoader ();
use Exporter ();
@@ -348,7 +346,7 @@
my $keeperr = { O=>0x0004 };
my @TieHash_IF = ( # Generic Tied Hash Interface
- 'STORE' => { O=>0x0418 },
+ 'STORE' => { O=>0x0418 | 0x4 },
'FETCH' => { O=>0x0404 },
'FIRSTKEY'=> $keeperr,
'NEXTKEY' => $keeperr,
@@ -482,7 +480,7 @@
my $olddbis = $DBI::_dbistate;
_clone_dbis() unless $DBI::PurePerl; # clone the DBIS structure
%DBI::installed_drh = (); # clear loaded drivers so they have a chance to
reinitialize
- DBI->trace_msg(sprintf "CONE DBI for new thread %s\n",
+ DBI->trace_msg(sprintf "CLONE DBI for new thread %s\n",
$DBI::PurePerl ? "" : sprintf("(dbis %x -> %x)",$olddbis, $DBI::_dbistate));
}
@@ -649,6 +647,7 @@
sub disconnect_all {
+ keys %DBI::installed_drh; # reset iterator
while ( my ($name, $drh) = each %DBI::installed_drh ) {
$drh->disconnect_all() if ref $drh;
}
@@ -726,7 +725,7 @@
# catch people on case in-sensitive systems using the wrong case
$advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
if $@ =~ /locate object method/;
- croak("$driver_class initialisation failed: [EMAIL PROTECTED]");
+ Carp::croak("$driver_class initialisation failed: [EMAIL PROTECTED]");
}
$DBI::installed_drh{$driver} = $drh;
@@ -990,7 +989,7 @@
sub connect_test_perf {
my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
- croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
+ Carp::croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
# these are non standard attributes just for this special method
my $loops ||= $attr->{dbi_loops} || 5;
my $par ||= $attr->{dbi_par} || 1; # parallelism
@@ -1139,7 +1138,6 @@
{ package # hide from PAUSE
DBD::Switch::dr;
DBI->setup_driver('DBD::Switch'); # sets up @ISA
- require Carp;
$DBD::Switch::dr::imp_data_size = 0;
$DBD::Switch::dr::imp_data_size = 0; # avoid typo warning
@@ -1212,14 +1210,14 @@
# to install new methods into the DBI dispatcher
# DBD::Foo::db->install_method("foo_mumble", { usage => [...], options =>
'...' });
my ($class, $method, $attr) = @_;
- croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
+ Carp::croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
my ($driver, $subtype) = ($1, $2);
- croak("invalid method name '$method'")
+ Carp::croak("invalid method name '$method'")
unless $method =~ m/^([a-z]+_)\w+$/;
my $prefix = $1;
my $reg_info = $dbd_prefix_registry->{$prefix};
- croak("method name prefix '$prefix' is not registered") unless $reg_info;
+ Carp::croak("method name prefix '$prefix' is not registered") unless $reg_info;
my %attr = %{$attr||{}}; # copy so we can edit
# XXX reformat $attr as needed for _install_method
my ($caller_pkg, $filename, $line) = caller;
@@ -1238,12 +1236,12 @@
my ($drh, $user, $pass, $attr) = @_;
unless (defined $user) {
$user = $ENV{DBI_USER};
- carp("DBI connect: user not defined and DBI_USER env var not set")
+ Carp::carp("DBI connect: user not defined and DBI_USER env var not set")
if 0 && !defined $user && $drh->{Warn}; # XXX enable later
}
unless (defined $pass) {
$pass = $ENV{DBI_PASS};
- carp("DBI connect: password not defined and DBI_PASS env var not set")
+ Carp::carp("DBI connect: password not defined and DBI_PASS env var not
set")
if 0 && !defined $pass && $drh->{Warn}; # XXX enable later
}
return ($user, $pass);
@@ -1291,6 +1289,7 @@
my $closure = $old_dbh->{dbi_connect_closure} or return;
unless ($attr) {
# copy attributes visible in the attribute cache
+ keys %$old_dbh; # reset iterator
while ( my ($k, $v) = each %$old_dbh ) {
# ignore non-code refs, i.e., caches, handles, Err etc
next if ref $v && ref $v ne 'CODE'; # HandleError etc
@@ -1486,6 +1485,7 @@
unless $dbh->FETCH('AutoCommit');
$dbh->STORE('AutoCommit', 0); # will croak if driver doesn't support it
$dbh->STORE('BegunWork', 1); # trigger post commit/rollback action
+ return 1;
}
sub primary_key {
@@ -1493,7 +1493,7 @@
my $sth = $dbh->primary_key_info(@args) or return;
my ($row, @col);
push @col, $row->[3] while ($row = $sth->fetch);
- croak("primary_key method not called in list context")
+ Carp::croak("primary_key method not called in list context")
unless wantarray; # leave us some elbow room
return @col;
}
@@ -2033,7 +2033,7 @@
The DBI package and all packages below it (C<DBI::*>) are reserved for
use by the DBI. Extensions and related modules use the C<DBIx::>
-namespace (see C<http://www.perl.com/CPAN/modules/by-module/DBIx/>).
+namespace (see L<http://www.perl.com/CPAN/modules/by-module/DBIx/>).
Package names beginning with C<DBD::> are reserved for use
by DBI database drivers. All environment variables used by the DBI
or by individual DBDs begin with "C<DBI_>" or "C<DBD_>".
@@ -2074,7 +2074,7 @@
http://ftp.digital.com/pub/DEC/SRC/technical-notes/SRC-1997-018-html/sqlr95.html
-Follow the "And the rest" and "Intergalactic dataspeak" links for the
+Follow the "Full Contents" then "Intergalactic dataspeak" links for the
SQL history.
=head2 Placeholders and Bind Values
@@ -2400,6 +2400,7 @@
perl -MDBI -e 'DBI->installed_versions'
+The installed_versions() method was added in DBI 1.38.
=item C<data_sources>
@@ -2414,17 +2415,14 @@
driver loading fails then data_sources() I<dies> with an error message
that includes the string "C<install_driver>" and the underlying problem.
-A $dbh can also be used as the $driver argument. In which case the
-$dbh serves to identify the driver and the driver may also use it
-to obtain more information about data sources, typically other
-databases managed by the same server that the $dbh is connected to.
-
Data sources are returned in a form suitable for passing to the
L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
Note that many drivers have no way of knowing what data sources might
be available for it. These drivers return an empty or incomplete list
-or may require a $dbh and/or driver-specific attributes.
+or may require driver-specific attributes.
+
+There is also a data_sources() method defined for database handles.
=item C<trace>
@@ -2531,7 +2529,7 @@
isn't specified) is based on the Perl 5.1 hash except that the value
is forced to be negative (for obscure historical reasons).
Type 1 is the better "Fowler / Noll / Vo" (FNV) hash. See
-http://www.isthe.com/chongo/tech/comp/fnv/ for more information.
+L<http://www.isthe.com/chongo/tech/comp/fnv/> for more information.
Both types are implemented in C and are very fast.
This function doesn't have much to do with databases, except that
@@ -2718,6 +2716,8 @@
Returns true if $method_name is implemented by the driver or a
default method is provided by the DBI.
+It returns false where a driver hasn't implemented a method and the
+default method is provided by the DBI is just an empty stub.
=back
@@ -2793,16 +2793,18 @@
=item C<InactiveDestroy> (boolean)
-The C<InactiveDestroy> attribute can be used to disable the I<database engine> related
-effect of DESTROYing a handle (which would normally close a prepared
-statement or disconnect from the database etc).
+The C<InactiveDestroy> attribute can be used to disable the I<database
+engine> related effect of DESTROYing a handle (which would normally
+close a prepared statement or disconnect from the database etc).
+The default value, false, means a handle will be fully destroyed
+when it passes out of scope.
For a database handle, this attribute does not disable an I<explicit>
-call to the disconnect method, only the implicit call from DESTROY.
+call to the disconnect method, only the implicit call from DESTROY
+that happens if the handle is still marked as C<Active>.
-The default value, false, means that a handle will be automatically
-destroyed when it passes out of scope. A true value disables automatic
-destruction. (Think of the name as meaning 'inactive the DESTROY method'.)
+Think of the name as meaning 'treat the handle as not-Active in the
+DESTROY method'.
This attribute is specifically designed for use in Unix applications
that "fork" child processes. Either the parent or the child process,
@@ -2810,6 +2812,12 @@
Note that some databases, including Oracle, don't support passing a
database connection across a fork.
+To help tracing applications using fork the process id is shown in
+the trace log whenever a DBI or handle trace() method is called.
+The process id also shown for I<every> method call if the DBI trace
+level (not handle trace level) is set high enough to show the trace
+from the DBI's method dispatcher, e.g. >= 9.
+
=item C<PrintError> (boolean, inherited)
The C<PrintError> attribute can be used to force errors to generate warnings (using
@@ -2857,11 +2865,6 @@
regardless of how the block is exited.
The same logic applies to other attributes, including C<PrintError>.
-Sadly, this doesn't work for Perl versions up to and including 5.004_04.
-Even more sadly, for Perl 5.5 and 5.6.0 it does work but leaks memory!
-For backwards compatibility, you could just use C<eval { ... }> instead.
-
-
=item C<HandleError> (code ref, inherited)
The C<HandleError> attribute can be used to provide your own alternative behaviour
@@ -3148,6 +3151,8 @@
Data sources are returned in a form suitable for passing to the
L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
+The data_sources() method, for a $dbh, was added in DBI 1.38.
+
=item C<do>
$rows = $dbh->do($statement) or die $dbh->errstr;
@@ -4273,8 +4278,8 @@
Quote will probably I<not> be able to deal with all possible input
(such as binary data or data containing newlines), and is not related in
-any way with escaping or quoting shell meta-characters. There is no
-need to quote values being used with L</"Placeholders and Bind Values">.
+any way with escaping or quoting shell meta-characters. The quote()
+method should I<not> be used with L</"Placeholders and Bind Values">.
=item C<quote_identifier>
@@ -4494,9 +4499,10 @@
$rv = $sth->bind_param($p_num, $bind_value, \%attr) or ...
$rv = $sth->bind_param($p_num, $bind_value, $bind_type) or ...
-The C<bind_param> method can be used to bind a value
-with a placeholder embedded in the prepared statement. Placeholders
-are indicated with question mark character (C<?>). For example:
+The C<bind_param> method takes a copy of $bind_value and associates it
+(binds it) with a placeholder, identified by $p_num, embedded in
+the prepared statement. Placeholders are indicated with question
+mark character (C<?>). For example:
$dbh->{RaiseError} = 1; # save having to check each method call
$sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE ?");
@@ -4566,7 +4572,7 @@
reference to the actual value to be used.
Note that unlike L</bind_param>, the C<$bind_value> variable is not
-read when C<bind_param_inout> is called. Instead, the value in the
+copied when C<bind_param_inout> is called. Instead, the value in the
variable is read at the time L</execute> is called.
The additional C<$max_len> parameter specifies the minimum amount of
@@ -4602,9 +4608,14 @@
$sth->bind_param_array(3, "SALES"); # scalar will be reused for each row
$sth->execute_array( { ArrayTupleStatus => \my @tuple_status } );
-The C<%attr> argument is the same as defined for L</bind_param>.
+The C<%attr> ($bind_type) argument is the same as defined for L</bind_param>.
Refer to L</bind_param> for general details on using placeholders.
+(Note that bind_param_array() can I<not> be used to expand a
+placeholder into a list of values for a statement like "SELECT foo
+WHERE bar IN (?)". A placeholder can only ever represent one value
+per execution.)
+
Each array bound to the statement must have the same number of
elements. Some drivers may define a method attribute to relax this
safety check.
@@ -5004,18 +5015,18 @@
$rc = $sth->finish;
-Indicates that no more data will be fetched from this statement handle
+Indicate that no more data will be fetched from this statement handle
before it is either executed again or destroyed. The C<finish> method
-is rarely needed, but can sometimes be helpful in very specific
-situations to allow the server to free up resources (such as sort
-buffers).
+is rarely needed, and frequently overused, but can sometimes be
+helpful in a few very specific situations to allow the server to free
+up resources (such as sort buffers).
When all the data has been fetched from a C<SELECT> statement, the
driver should automatically call C<finish> for you. So you should
I<not> normally need to call it explicitly I<except> when you know
that you've not fetched all the data from a statement handle.
The most common example is when you only want to fetch one row,
-but in that case the C<selectrow_*> methods may be better anyway.
+but in that case the C<selectrow_*> methods are usually better anyway.
Adding calls to C<finish> after each fetch loop is a common mistake,
don't do it, it can mask genuine problems like uncaught fetch errors.
@@ -5449,7 +5460,9 @@
};
if ($@) {
warn "Transaction aborted because $@";
- $dbh->rollback; # undo the incomplete changes
+ # now rollback to undo the incomplete changes
+ # but do it in an eval{} as it may also fail
+ eval { $dbh->rollback };
# add other application on-error-clean-up code here
}
@@ -5567,8 +5580,7 @@
=head2 Threads and Thread Safety
Perl 5.7 and later support a new threading model called iThreads.
-(The old and fatally flawed "5.005 style" threads are not supported
-by the DBI.)
+(The old "5.005 style" threads are not supported by the DBI.)
In the iThreads model each thread has it's own copy of the perl
interpreter. When a new thread is created the original perl
@@ -5670,7 +5682,7 @@
If both forms are used then the attribute takes precedence.
-The when subclassing is being used then, after a successful new
+When subclassing is being used then, after a successful new
connect, the DBI->connect method automatically calls:
$dbh->connected($dsn, $user, $pass, \%attr);
@@ -6016,6 +6028,7 @@
http://wdvl.com/Authoring/DB/Intro/toc.html
http://www.hotwired.com/webmonkey/backend/tutorials/tutorial1.html
http://bumppo.net/lists/macperl/1999/06/msg00197.html
+ http://gmax.oltrelinux.com/dbirecipes.html
Other database related links:
@@ -6024,8 +6037,13 @@
Security, especially the "SQL Injection" attack:
+ http://www.ngssoftware.com/research/papers.html
+ http://www.ngssoftware.com/papers/advanced_sql_injection.pdf
+ http://www.ngssoftware.com/papers/more_advanced_sql_injection.pdf
+ http://www.esecurityplanet.com/trends/article.php/2243461
+ http://www.spidynamics.com/papers/SQLInjectionWhitePaper.pdf
+ http://www.webcohort.com/Blindfolded_SQL_Injection.pdf
http://online.securityfocus.com/infocus/1644
- http://www.nextgenss.com/research/papers.html
Commercial and Data Warehouse Links
@@ -6054,7 +6072,7 @@
=head1 COPYRIGHT
-The DBI module is Copyright (c) 1994-2002 Tim Bunce. Ireland.
+The DBI module is Copyright (c) 1994-2003 Tim Bunce. Ireland.
All rights reserved.
You may distribute under the terms of either the GNU General Public
@@ -6195,11 +6213,6 @@
http://www.boutell.com/faq/
http://www.perl.com/perl/faq/
-General problems and good ideas:
-
- Use the CGI::ErrorWrap module.
- Remember that many env vars won't be set for CGI scripts.
-
=head2 How can I maintain a WWW connection to a database?
For information on the Apache httpd server and the C<mod_perl> module see
@@ -6208,7 +6221,7 @@
=head2 What about ODBC?
-A DBD::ODBC module is available.
+A DBD::ODBC driver module for ODBC is available and works well.
=head2 Does the DBI have a year 2000 problem?
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sun Feb 1 02:28:40 2004
@@ -1,6 +1,6 @@
/* vim: ts=8:sw=4
*
- * $Id: DBI.xs,v 11.32 2003/08/21 22:34:45 timbo Exp $
+ * $Id: DBI.xs,v 11.36 2003/11/27 23:29:06 timbo Exp $
*
* Copyright (c) 1994-2003 Tim Bunce Ireland.
*
@@ -148,24 +148,19 @@
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-# if (PATCHLEVEL == 4) && (SUBVERSION < 68)
-# define dPERINTERP_SV \
- SV *perinterp_sv = get_sv(MY_VERSION, FALSE)
-# else
# define dPERINTERP_SV \
SV *perinterp_sv = *hv_fetch(PL_modglobal, MY_VERSION, \
sizeof(MY_VERSION)-1, TRUE)
-# endif
# define dPERINTERP_PTR(T,name) \
- T name = (T)(perinterp_sv && SvIOK(perinterp_sv) \
- ? (T)SvIVX(perinterp_sv) : NULL)
+ T name = (perinterp_sv && SvIOK(perinterp_sv) \
+ ? INT2PTR(T, SvIVX(perinterp_sv)) : (T)NULL)
# define dPERINTERP \
dPERINTERP_SV; dPERINTERP_PTR(PERINTERP_t *, PERINTERP)
# define INIT_PERINTERP \
dPERINTERP; \
Newz(0,PERINTERP,1,PERINTERP_t); \
- sv_setiv(perinterp_sv, (IV)PERINTERP)
+ sv_setiv(perinterp_sv, PTR2IV(PERINTERP))
# undef DBIS
# define DBIS (PERINTERP->dbi_state)
@@ -203,6 +198,7 @@
static void
dbi_bootinit(dbistate_t * parent_dbis)
{
+ char *p = Nullch;
INIT_PERINTERP;
Newz(dummy, DBIS, 1, dbistate_t);
@@ -215,7 +211,8 @@
DBIS->logmsg = dbih_logmsg;
DBIS->logfp = PerlIO_stderr();
- DBIS->debug = (parent_dbis) ? parent_dbis->debug : 0;
+ DBIS->debug = (parent_dbis) ? parent_dbis->debug
+ : atoi((p=getenv("DBI_TRACE")) ? p : "0");
DBIS->neatsvpvlen = (parent_dbis) ? parent_dbis->neatsvpvlen
: perl_get_sv("DBI::neat_maxlen", GV_ADDMULTI);
#ifdef DBI_USE_THREADS
@@ -223,10 +220,15 @@
#endif
/* publish address of dbistate so dynaloaded DBD's can find it */
- sv_setiv(perl_get_sv(DBISTATE_PERLNAME,1), (IV)DBIS);
+ sv_setiv(perl_get_sv(DBISTATE_PERLNAME,1), PTR2IV(DBIS));
DBISTATE_INIT; /* check DBD code to set DBIS from DBISTATE_PERLNAME */
+ if (DBIS->debug) {
+ if (DBIS->debug >= 9)
+ sv_dump(DBISTATE_ADDRSV);
+ }
+
/* store some function pointers so DBD's can call our functions */
DBIS->getcom = dbih_getcom;
DBIS->clearcom = dbih_clearcom;
@@ -281,6 +283,8 @@
char *v, *quote;
/* We take care not to alter the supplied sv in any way at all. */
+ /* (but if it is SvGMAGICAL we have to call mg_get and that can */
+ /* have side effects, especially as it may e called twice overall.) */
if (!sv)
return "Null!"; /* should never happen */
@@ -522,8 +526,8 @@
set_trace_file(file);
if (level != RETVAL) { /* set value */
if (level > 0) {
- PerlIO_printf(DBILOGFP," %s trace level set to %d in DBI %s%s\n",
- neatsvpv(h,0), level, XS_VERSION, dbi_build_opt);
+ PerlIO_printf(DBILOGFP," %s trace level set to %d in DBI %s%s (pid
%d)\n",
+ neatsvpv(h,0), level, XS_VERSION, dbi_build_opt,
(int)PerlProc_getpid());
if (!dowarn && level>0)
PerlIO_printf(DBILOGFP," Note: perl is running without the
recommended perl -w option\n");
PerlIO_flush(DBILOGFP);
@@ -2189,7 +2193,7 @@
char *can_meth = SvPV(st1,lna);
SV *dbi_msv = Nullsv;
SV *imp_msv; /* handle implementors method (GV or CV) */
- if ( (imp_msv = (SV*)gv_fetchmethod(DBIc_IMP_STASH(imp_xxh),
can_meth)) ) {
+ if ( (imp_msv =
(SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), can_meth, FALSE)) ) {
/* return DBI's CV, not the implementors CV (else we'd bypass
dispatch) */
/* and anyway, we may have hit a private method not part of
the DBI */
GV *gv = gv_fetchmethod_autoload(SvSTASH(SvRV(orig_h)),
can_meth, FALSE);
@@ -2201,10 +2205,8 @@
PerlIO_printf(logfp," <- %s(%s) = %p (%s %p)\n", meth_name,
can_meth, dbi_msv,
(imp_msv && isGV(imp_msv)) ? HvNAME(GvSTASH(imp_msv))
: "?", imp_msv);
}
- if (dbi_msv) {
- ST(0) = sv_2mortal(newRV(dbi_msv));
- XSRETURN(1);
- }
+ ST(0) = (dbi_msv) ? sv_2mortal(newRV(dbi_msv)) : &PL_sv_undef;
+ XSRETURN(1);
}
XSRETURN(0);
}
@@ -2318,8 +2320,14 @@
/* --- dispatch --- */
- if (!keep_error)
+ if (!keep_error) {
+ if (debug >= 4 && SvTRUE(DBIc_ERR(imp_xxh))) {
+ PerlIO *logfp = DBILOGFP;
+ PerlIO_printf(logfp, " !! ERROR: %s CLEARED by call to %s method\n",
+ neatsvpv(DBIc_ERR(imp_xxh),0), meth_name);
+ }
DBIh_CLEAR_ERROR(imp_xxh);
+ }
/* The "quick_FETCH" logic... */
/* Shortcut for fetching attributes to bypass method call overheads */
@@ -2354,13 +2362,13 @@
if (debug) {
SAVEI32(DBIS->debug); /* fall back to orig value later */
+ DBIS->debug = debug; /* make value global (for now) */
if (ima && debug < ima->trace_level) {
debug = 0; /* silence dispatch log for this method */
}
- DBIS->debug = debug; /* make value global (for now) */
}
- imp_msv = (SV*)gv_fetchmethod(DBIc_IMP_STASH(imp_xxh), meth_name);
+ imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), meth_name,
FALSE);
if (debug >= 2) {
PerlIO *logfp = DBILOGFP;
@@ -2436,6 +2444,7 @@
}
else {
+ /* sv_dump(imp_msv); */
outitems = perl_call_sv(isGV(imp_msv) ? (SV*)GvCV(imp_msv) : imp_msv,
(is_DESTROY ? gimme | G_EVAL | G_KEEPERR : gimme) );
}
@@ -2453,7 +2462,11 @@
post_dispatch:
- if (debug >= 1) {
+ if (debug >= 1
+ && !(debug == 1 /* don't trace nested calls at level 1 */
+ && call_depth <= 1
+ && (!DBIc_PARENT_COM(imp_xxh) || DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh))
< 1))
+ ) {
PerlIO *logfp = DBILOGFP;
int is_fetch = (*meth_name=='f' && DBIc_TYPE(imp_xxh)==DBIt_ST &&
strnEQ(meth_name,"fetch",5));
int row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0;
@@ -3279,8 +3292,8 @@
set_trace_file(file); /* always call this regardless of level */
if (level != DBIS->debug) {
if (level > 0) {
- PerlIO_printf(DBILOGFP," DBI %s%s dispatch trace level set to %d\n",
- XS_VERSION, dbi_build_opt, level);
+ PerlIO_printf(DBILOGFP," DBI %s%s dispatch trace level set to %d (in
pid %d)\n",
+ XS_VERSION, dbi_build_opt, level, (int)PerlProc_getpid());
if (!dowarn)
PerlIO_printf(DBILOGFP," Note: perl is running without the
recommended perl -w option\n");
PerlIO_flush(DBILOGFP);
Modified: dbi/trunk/DBIXS.h
==============================================================================
--- dbi/trunk/DBIXS.h (original)
+++ dbi/trunk/DBIXS.h Sun Feb 1 02:28:40 2004
@@ -1,4 +1,4 @@
-/* $Id: DBIXS.h,v 11.15 2003/05/26 23:28:42 timbo Exp $
+/* $Id: DBIXS.h,v 11.17 2003/11/13 13:04:38 timbo Exp $
*
* Copyright (c) 1994-2002 Tim Bunce Ireland
*
@@ -416,19 +416,19 @@
# define DBISTATE_ASSIGN(st)
# define DBISTATE_INIT
# undef DBIS
-# define DBIS (*(dbistate_t**)&SvIVX(DBISTATE_ADDRSV))
+# define DBIS (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV))))
/* 'dbis' is temp for bad drivers using 'dbis' instead of 'DBIS' */
-# define dbis (*(dbistate_t**)&SvIVX(DBISTATE_ADDRSV))
+# define dbis (*(INT2PTR(dbistate_t**, &SvIVX(DBISTATE_ADDRSV))))
#else /* plain and simple non perl object / multiplicity case */
# define DBISTATE_DECLARE static dbistate_t *DBIS
# define DBISTATE_ASSIGN(st) (DBIS = (st))
-# define DBISTATE_INIT_DBIS DBISTATE_ASSIGN((dbistate_t*)SvIV(DBISTATE_ADDRSV))
+# define DBISTATE_INIT_DBIS DBISTATE_ASSIGN(INT2PTR(dbistate_t*,
SvIV(DBISTATE_ADDRSV)))
# define DBISTATE_INIT { /* typically use in BOOT: of XS file */ \
DBISTATE_INIT_DBIS; \
if (DBIS == NULL) \
- croak("Unable to get DBI state. DBI not loaded."); \
+ croak("Unable to get DBI state from %s at %p. DBI not loaded.",
DBISTATE_PERLNAME, DBISTATE_ADDRSV); \
DBIS->check_version(__FILE__, DBISTATE_VERSION, sizeof(*DBIS),
NEED_DBIXS_VERSION, \
sizeof(dbih_drc_t), sizeof(dbih_dbc_t), sizeof(dbih_stc_t),
sizeof(dbih_fdc_t) \
); \
Modified: dbi/trunk/META.yml
==============================================================================
--- dbi/trunk/META.yml (original)
+++ dbi/trunk/META.yml Sun Feb 1 02:28:40 2004
@@ -1,9 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBI
-version: 1.38
+version: 1.39
version_from: DBI.pm
installdirs: site
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.10_03
+generated_by: ExtUtils::MakeMaker version 6.21
Modified: dbi/trunk/Makefile.PL
==============================================================================
--- dbi/trunk/Makefile.PL (original)
+++ dbi/trunk/Makefile.PL Sun Feb 1 02:28:40 2004
@@ -1,6 +1,6 @@
# -*- perl -*-
#
-# $Id: Makefile.PL,v 11.18 2003/08/20 00:15:24 timbo Exp $
+# $Id: Makefile.PL,v 11.19 2003/11/12 10:02:10 timbo Exp $
#
# Copyright (c) 1994-2002 Tim Bunce England
#
@@ -74,9 +74,9 @@
print "of perl threading (now known as '5005 threads'). It is badly flawed\n";
print "and could never be safe to use in production environments.\n\n";
print "If you are using multiple threads you are *strongly* encouraged to\n";
- print "upgrade to perl 5.8.x or later.\n";
+ print "upgrade to perl 5.8.2 or later.\n";
print "If you are not using multiple threads you are *strongly* encouraged
to\n";
- print "upgrade to at least 5.6.x (preferably perl 5.8.x or later.)\n";
+ print "upgrade to at least 5.6.1 (preferably perl 5.8.2 or later.)\n";
print "or at the very least rebuild this version with threading disabled.\n";
print "If you have stick with your current build of perl...\n";
print "then you also have to stick with DBI 1.28 for safety.\n";
@@ -111,12 +111,13 @@
if (@missing) {
print <<'MSG';
Optional modules are available from any CPAN mirror, in particular
+ http://search.cpan.org/
http://www.perl.com/CPAN/modules/by-module
http://www.perl.org/CPAN/modules/by-module
ftp://ftp.funet.fi/pub/languages/perl/CPAN/modules/by-module
MSG
- sleep 5;
+ sleep 4;
}
Modified: dbi/trunk/README
==============================================================================
--- dbi/trunk/README (original)
+++ dbi/trunk/README Sun Feb 1 02:28:40 2004
@@ -1,6 +1,6 @@
DBI - The Perl Database Interface by Tim Bunce.
-Copyright (c) 1994-2002 Tim Bunce Ireland.
+Copyright (c) 1994-2003 Tim Bunce Ireland.
See COPYRIGHT section in DBI.pm for usage and distribution rights.
@@ -14,7 +14,8 @@
QUICK START GUIDE:
- The DBI requires one or more 'driver' modules to talk to databases.
+ The DBI requires one or more 'driver' modules to talk to databases,
+ but they are not needed to build or install the DBI.
Check that a DBD::* module exists for the database you wish to use.
@@ -56,7 +57,7 @@
BEFORE BUILDING, TESTING AND INSTALLING this you will need to:
- Build, test and install Perl 5 (5.005_03 or later).
+ Build, test and install Perl 5 (5.6 or later).
It is very important to test it and actually install it!
(You can use "Configure -Dprefix=..." to build a private copy.)
Modified: dbi/trunk/ToDo
==============================================================================
--- dbi/trunk/ToDo (original)
+++ dbi/trunk/ToDo Sun Feb 1 02:28:40 2004
@@ -1,10 +1,27 @@
*** Assorted to-do items and random thoughts *** IN NO PARTICULAR ORDER ***
-Polish up and document _dbtype_names with an external interface and using get_info.
+Ability to remove an sth from the prepare_cached cache.
+ $sth->uncache;
+and $dbh->uncache; for connect_cached
+implies duplication of key key code or iterate through cache.
+$h->uncache and/or option to prepare_cache to discard (and replace)
+cached $sth if it's still active. Or weak refs?
+
+Add PERL_NO_GET_CONTEXT for multiplicity/threads?
+And enable xsbypass if possible.
+
+Perhaps $h->{PrintWarn} $h->{RaiseWarn} $h->{HandleWarn}
+or better still, a more general event mechanism
+but one that makes the above very easy: $h->{HandleEvent}
+but need to classify 'events'. At least SUCCESS_WITH_INFO
+(which covers eg mysql warnings), and something for 'messages'
+from the server while exevuting stored procedures.
-Don't show attrib FETCH from cache if trace level is 1
-Always show fetch/fetchrow_arrayref return even at level 1?
+$dbh->ping($skip_seconds) - skip the ping if ping'd less than $skip_seconds ago
+Change connect_cached to use ping($skip_seconds || 10);
+
+Polish up and document _dbtype_names with an external interface and using get_info.
$sth->{ParamTypes} eg { "1" => SQL_VARCHAR, "2" => { TYPE=>SQL_VARCHAR, ora_type=>99
}};
@@ -20,10 +37,6 @@
Hook to call code ref on each fetch, pass fbav ref
datarow_array(), datarow_arrayref(), datarow_hashref()
remove sth from prepare_cached cache.
-$sth/$dbh->last_insert_id
-
-Ability to remove an sth from the prepare_cached cache.
- $sth->uncache;
DBI->setup_driver alias for _setup_driver, and make idempotent.
@@ -62,7 +75,6 @@
Check: local($h->{PrintError})=0; resets $DBI::errstr at end of scope?
-ShowTracePid attrib ( or just add to trace level change message)
Add UnimpMethodHook (in XS)
Test and integrate with DProf?
FetchHashReuse attrib (=1 or ={}) copy from dbh to sth.
@@ -252,3 +264,4 @@
Tim.
-----------
+
Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm Sun Feb 1 02:28:40 2004
@@ -6,9 +6,9 @@
use DBI qw(:sql_types);
@EXPORT = qw(); # Do NOT @EXPORT anything.
- $VERSION = sprintf("%d.%02d", q$Revision: 11.10 $ =~ /(\d+)\.(\d+)/o);
+ $VERSION = sprintf("%d.%02d", q$Revision: 11.11 $ =~ /(\d+)\.(\d+)/o);
-# $Id: ExampleP.pm,v 11.10 2003/05/10 23:30:28 timbo Exp $
+# $Id: ExampleP.pm,v 11.11 2003/10/21 15:13:43 timbo Exp $
#
# Copyright (c) 1994,1997,1998 Tim Bunce
#
@@ -358,10 +358,10 @@
# either return dynamic values that cannot be precomputed
# or fetch and cache attribute values too expensive to prefetch.
if ($attrib eq 'TYPE'){
- return [ @DBD::ExampleP::stattypes{ @{ $sth->{NAME_lc} } } ];
+ return [ @DBD::ExampleP::stattypes{ @{ $sth->FETCH(q{NAME_lc}) } } ];
}
elsif ($attrib eq 'PRECISION'){
- return [ @DBD::ExampleP::statprec{ @{ $sth->{NAME_lc} } } ];
+ return [ @DBD::ExampleP::statprec{ @{ $sth->FETCH(q{NAME_lc}) } } ];
}
elsif ($attrib eq 'ParamValues') {
my $dbd_param = $sth->{dbd_param} || [];
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Sun Feb 1 02:28:40 2004
@@ -2,10 +2,10 @@
use vars qw($VERSION); # set $VERSION early so we don't confuse PAUSE/CPAN etc
-$VERSION = sprintf("%d.%02d", q$Revision: 11.18 $ =~ /(\d+)\.(\d+)/o);
+$VERSION = sprintf("%d.%02d", q$Revision: 11.19 $ =~ /(\d+)\.(\d+)/o);
-# $Id: DBD.pm,v 11.18 2003/08/20 00:15:24 timbo Exp $
+# $Id: DBD.pm,v 11.19 2003/11/12 10:02:10 timbo Exp $
#
# Copyright (c) 1997-2003 Jonathan Leffler, Jochen Wiedmann, Steffen
# Goeldner and Tim Bunce
@@ -58,8 +58,8 @@
=head2 Version and volatility
- $Revision: 11.18 $
- $Date: 2003/08/20 00:15:24 $
+ $Revision: 11.19 $
+ $Date: 2003/11/12 10:02:10 $
This document is I<still> a minimal draft which is in need of further work.
@@ -708,7 +708,7 @@
SCCS version number is probably not appropriate (despite being very
common). For RCS or CVS you can use this code:
- $VERSION = sprintf "%d.%02d", '$Revision: 11.18 $ ' =~ /(\d+)\.(\d+)/;
+ $VERSION = sprintf "%d.%02d", '$Revision: 11.19 $ ' =~ /(\d+)\.(\d+)/;
which pads out the fractional part with leading zeros so all is well
(so long as you don't go past x.99)
@@ -1230,6 +1230,9 @@
implement driver-specific any code in your FETCH and STORE methods unless
you need extra logic/checks, beyond getting or setting the value.
+Unless your driver documentation indicates otherwise, the return value of
+the STORE method is unspecified and the caller shouldn't use that value.
+
=cut
#=head4 Other database handle methods
@@ -3086,6 +3089,8 @@
=pod
+=back
+
=over 2
=item Generating the type_info method
@@ -3117,12 +3122,14 @@
lib/DBD/Driver/TypeInfo.pm.
You should review the output to ensure that it is sensible.
+=back
+
=head2 Writing DBD::Driver::db::get_info
-If you use the DBI::DBD::GetInfo module, then the code you need is
+If you use the DBI::DBD::Metadata module, then the code you need is
generated for you.
-If you decide not to use the DBI::DBD::GetInfo module, you should
+If you decide not to use the DBI::DBD::Metadata module, you should
probably borrow the code from a driver that has done so (eg
DBD::Informix from version 1.05 onwards) and crib the code from there,
or look at the code that generates that module and follow that.
@@ -3137,10 +3144,10 @@
=head2 Writing DBD::Driver::db::type_info_all
-If you use the DBI::DBD::TypeInfo module, then the code you need is
+If you use the DBI::DBD::Metadata module, then the code you need is
generated for you.
-If you decide not to use the DBI::DBD::TypeInfo module, you should
+If you decide not to use the DBI::DBD::Metadata module, you should
probably borrow the code from a driver that has done so (eg
DBD::Informix from version 1.05 onwards) and crib the code from there,
or look at the code that generates that module and follow that.
@@ -3561,9 +3568,8 @@
sub _cwd_check {
my $cwd = cwd();
- return unless $cwd =~ m/:/;
- return if $^O eq 'darwin';
- warn "*** Warning: Colons in the current directory path ($cwd) may cause
problems\a\n";
+ return unless $cwd =~ /$Config{path_sep}/;
+ warn "*** Warning: Path separator characters (`$Config{path_sep}') in the current
directory path ($cwd) may cause problems\a\n";
sleep 2;
}
@@ -3673,7 +3679,7 @@
Jonathan Leffler <[EMAIL PROTECTED]> (previously <[EMAIL PROTECTED]>),
Jochen Wiedmann <[EMAIL PROTECTED]>,
-Steffen Goeldner <[EMAIL PROTECTED]>,
+Steffen Goeldner <[EMAIL PROTECTED]>,
and Tim Bunce <[EMAIL PROTECTED]>.
=cut
Modified: dbi/trunk/t/05thrclone.t
==============================================================================
--- dbi/trunk/t/05thrclone.t (original)
+++ dbi/trunk/t/05thrclone.t Sun Feb 1 02:28:40 2004
@@ -17,6 +17,8 @@
# ---
+{ package threads_sub; use base qw(threads); }
+
use DBI;
#threads->create( sub { 1 } )->join; warn 2; exit 0;
@@ -29,7 +31,7 @@
my @thr;
foreach (1..10) {
- push @thr, threads->create( \&tests1 );
+ push @thr, threads_sub->create( \&tests1 );
tests1();
}
$_->join foreach @thr;
Modified: dbi/trunk/t/30subclass.t
==============================================================================
--- dbi/trunk/t/30subclass.t (original)
+++ dbi/trunk/t/30subclass.t Sun Feb 1 02:28:40 2004
@@ -47,6 +47,9 @@
sub fetch {
my($sth, @args) = @_;
++$calls;
+ # this is just to trigger (re)STORE on exit to test that the STORE
+ # doesn't clear any erro condition
+ local $sth->{Taint} = 0;
my $row = $sth->SUPER::fetch(@args);
if ($row) {
# modify fetched data as an example
@@ -79,7 +82,7 @@
return print "ok $t at $line\n"
if( ( defined($got) && defined($want) && $got eq $want)
|| (!defined($got) && !defined($want)) );
- warn "Test $n: wanted '$want', got '$got'\n";
+ warn sprintf "Test $n: wanted %s, got %s\n", DBI::neat($want), DBI::neat($got);
print "not ok $t at $line\n";
}
