Author: timbo
Date: Mon Feb 23 06:56:54 2004
New Revision: 137
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/lib/DBD/NullP.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/03handle.t
dbi/trunk/t/41prof_dump.t
dbi/trunk/test.pl
Log:
Fixed $sth->{NUM_OF_FIELDS} of non-executed statement handle
to be undef as per the docs (it was 0).
Fixed t/41prof_dump.t to work with perl5.9.1.
Changed attributes (NAME, TYPE etc) of non-executed statement
handle to be undef instead of triggering an error.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Feb 23 06:56:54 2004
@@ -4,6 +4,15 @@
=cut
+=head1 CHANGES in DBI 1.42 (svn rev XX), XXnd February 2004
+
+ Fixed $sth->{NUM_OF_FIELDS} of non-executed statement handle
+ to be undef as per the docs (it was 0).
+ Fixed t/41prof_dump.t to work with perl5.9.1.
+
+ Changed attributes (NAME, TYPE etc) of non-executed statement
+ handle to be undef instead of triggering an error.
+
=head1 CHANGES in DBI 1.41 (svn rev 130), 22nd February 2004
Fixed execute_for_array() so tuple_status parameter is optional
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Mon Feb 23 06:56:54 2004
@@ -6501,7 +6501,8 @@
svn checkout http://svn.perl.org/modules/dbi/trunk
If it prompts for a username and password use your perl.org account
-if you have one, else just 'guest' and 'guest'.
+if you have one, else just 'guest' and 'guest'. The source code will
+be in a new subdirectory called C<trunk>.
After making your changes you can generate a patch file, but before
you do, make sure your source is still upto date using:
@@ -6509,7 +6510,7 @@
svn update http://svn.perl.org/modules/dbi/trunk
If you get any conflicts reported you'll need to fix them first.
-Then generate the patch file using:
+Then generate the patch file from within the C<trunk> directory using:
svn diff > foo.patch
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon Feb 23 06:56:54 2004
@@ -996,6 +996,7 @@
hv_fetch((HV*)SvRV(h), "Statement", 9, 1); /* store writable undef */
break;
case DBIt_ST:
+ DBIc_NUM_FIELDS((imp_sth_t*)imp) = -1;
/* cache _inner_ handle, but also see quick_FETCH */
hv_store((HV*)SvRV(h), "Database", 8, newRV(SvRV(parent)), 0);
/* copy (alias) Statement from the sth up into the dbh */
@@ -1569,6 +1570,17 @@
break;
case 'N':
+ if (keylen==8 && strEQ(key, "NULLABLE")) {
+ valuesv = &sv_undef;
+ break;
+ }
+
+ if (keylen==4 && strEQ(key, "NAME")) {
+ valuesv = &sv_undef;
+ break;
+ }
+
+ /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */
if ((keylen==7 || keylen==9 || keylen==12)
&& strnEQ(key, "NAME_", 5)
&& ( (keylen==9 && strEQ(key, "NAME_hash"))
@@ -1577,17 +1589,16 @@
)
) {
D_imp_sth(h);
- AV *name_av = NULL;
valuesv = &sv_undef;
/* fetch from tied outer handle to trigger FETCH magic */
svp = hv_fetch((HV*)DBIc_MY_H(imp_sth), "NAME",4, FALSE);
sv = (svp) ? *svp : &sv_undef;
- if (SvGMAGICAL(sv)) /* resolve the magic */
- mg_get(sv); /* can core dump in 5.004 */
- name_av = (AV*)SvRV(sv);
+ if (SvGMAGICAL(sv)) /* call FETCH via magic */
+ mg_get(sv);
- if (sv && name_av) {
+ if (SvROK(sv)) {
+ AV *name_av = (AV*)SvRV(sv);
char *name;
int upcase = (key[5] == 'u');
AV *av = Nullav;
@@ -1622,8 +1633,9 @@
}
else if (keylen==13 && strEQ(key, "NUM_OF_FIELDS")) {
D_imp_sth(h);
- valuesv = newSViv(DBIc_NUM_FIELDS(imp_sth));
- if (DBIc_NUM_FIELDS(imp_sth) > 0)
+ IV num_fields = DBIc_NUM_FIELDS(imp_sth);
+ valuesv = (num_fields < 0) ? &sv_undef : newSViv(num_fields);
+ if (num_fields > 0)
cacheit = TRUE; /* can't change once set */
}
else if (keylen==13 && strEQ(key, "NUM_OF_PARAMS")) {
@@ -1633,10 +1645,26 @@
}
break;
+ case 'P':
+ if (strEQ(key, "PRECISION"))
+ valuesv = &sv_undef;
+ else if (strEQ(key, "ParamValues"))
+ valuesv = &sv_undef;
+ break;
+
case 'R':
- if (keylen==11 && strEQ(key, "RowsInCache")) {
+ if (strEQ(key, "RowsInCache"))
+ valuesv = &sv_undef;
+ break;
+
+ case 'S':
+ if (strEQ(key, "SCALE"))
+ valuesv = &sv_undef;
+ break;
+
+ case 'T':
+ if (strEQ(key, "TYPE"))
valuesv = &sv_undef;
- }
break;
}
Modified: dbi/trunk/lib/DBD/NullP.pm
==============================================================================
--- dbi/trunk/lib/DBD/NullP.pm (original)
+++ dbi/trunk/lib/DBD/NullP.pm Mon Feb 23 06:56:54 2004
@@ -87,8 +87,9 @@
use strict;
sub execute {
- my($sth, $dir) = @_;
- $sth->{dbd_nullp_data} = $dir if $dir;
+ my($sth, $data) = @_;
+ $sth->{dbd_nullp_data} = $data if $data;
+ $sth->{NAME} = [ "fieldname" ];
1;
}
@@ -111,7 +112,6 @@
my ($sth, $attrib) = @_;
# would normally validate and only fetch known attributes
# else pass up to DBI to handle
- return [ "fieldname" ] if $attrib eq 'NAME';
return $sth->DBD::_::st::FETCH($attrib);
}
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Mon Feb 23 06:56:54 2004
@@ -140,16 +140,20 @@
Kids
LongReadLen
NAME NAME_uc NAME_lc NAME_uc_hash NAME_lc_hash
+ NULLABLE
NUM_OF_FIELDS
NUM_OF_PARAMS
Name
+ PRECISION
ParamValues
Profile
Provider
RootClass
- RowsInCache
RowCacheSize
+ RowsInCache
+ SCALE
Statement
+ TYPE
TraceLevel
Username
Version
@@ -410,6 +414,7 @@
if (ref($parent) =~ /::db$/) {
$h_inner->{Database} = $parent;
$parent->{Statement} = $h_inner->{Statement};
+ $h_inner->{NUM_OF_PARAMS} = 0;
}
elsif (ref($parent) =~ /::dr$/){
$h_inner->{Driver} = $parent;
@@ -597,7 +602,7 @@
}
if ($key =~ /^NAME.*_hash$/) {
my $i=0;
- for my $c(@{$h->FETCH('NAME')}) {
+ for my $c(@{$h->FETCH('NAME')||[]}) {
$h->{'NAME_hash'}->{$c} = $i;
$h->{'NAME_lc_hash'}->{"\L$c"} = $i;
$h->{'NAME_uc_hash'}->{"\U$c"} = $i;
Modified: dbi/trunk/t/03handle.t
==============================================================================
--- dbi/trunk/t/03handle.t (original)
+++ dbi/trunk/t/03handle.t Mon Feb 23 06:56:54 2004
@@ -1,12 +1,12 @@
#!perl -w
use strict;
-use Test;
+use Test::More;
use Data::Dumper;
# handle tests
-BEGIN { plan tests => 34 }
+BEGIN { plan tests => 49 }
use DBI;
@@ -51,7 +51,7 @@
my $drh = DBI->install_driver($driver);
ok($drh);
-ok($drh->{Kids}, 0);
+is($drh->{Kids}, 0);
# --- handle reference leak tests
@@ -74,7 +74,7 @@
) {
print "ref leak using @{[ %$args ]}\n";
work( %$args );
- ok($drh->{Kids}, 0);
+ is($drh->{Kids}, 0);
}
# --- handle take_imp_data test
@@ -97,11 +97,11 @@
{
my ($tmp, $warn);
local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /after take_imp_data/ };
-ok($tmp=$dbh->{Driver}, undef);
-ok($tmp=$dbh->{TraceLevel}, undef);
-ok($dbh->disconnect, undef);
-ok($dbh->quote(42), undef);
-ok($warn, 4);
+is($tmp=$dbh->{Driver}, undef);
+is($tmp=$dbh->{TraceLevel}, undef);
+is($dbh->disconnect, undef);
+is($dbh->quote(42), undef);
+is($warn, 4);
}
print "use dbi_imp_data\n";
@@ -114,4 +114,25 @@
ok(1) for (1..8);
}
+print "NullP statement handle attributes without execute\n";
+my $dbh = DBI->connect("dbi:NullP:", '', '');
+my $sth = $dbh->prepare("foo bar");
+is $sth->{NUM_OF_PARAMS}, 0;
+is $sth->{NUM_OF_FIELDS}, undef;
+is $sth->{Statement}, "foo bar";
+is $sth->{NAME}, undef;
+is $sth->{TYPE}, undef;
+is $sth->{SCALE}, undef;
+is $sth->{PRECISION}, undef;
+is $sth->{NULLABLE}, undef;
+is $sth->{RowsInCache}, undef;
+is $sth->{ParamValues}, undef;
+# derived NAME attributes
+is $sth->{NAME_uc}, undef;
+is $sth->{NAME_lc}, undef;
+is $sth->{NAME_hash}, undef;
+is $sth->{NAME_uc_hash}, undef;
+is $sth->{NAME_lc_hash}, undef;
+
+
exit 0;
Modified: dbi/trunk/t/41prof_dump.t
==============================================================================
--- dbi/trunk/t/41prof_dump.t (original)
+++ dbi/trunk/t/41prof_dump.t Mon Feb 23 06:56:54 2004
@@ -51,8 +51,9 @@
# has a header?
ok($prof =~ /^DBI::ProfileDumper\s+([\d.]+)/);
-# version matches VERSION?
-ok($1, $DBI::ProfileDumper::VERSION);
+# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
+# it's a stringified version object that looks like N.N.N)
+ok($1, DBI::ProfileDumper->VERSION);
# check that expected key is there
ok($prof =~ /\+\s+1\s+\Q$sql\E/m);
Modified: dbi/trunk/test.pl
==============================================================================
--- dbi/trunk/test.pl (original)
+++ dbi/trunk/test.pl Mon Feb 23 06:56:54 2004
@@ -102,8 +102,12 @@
my $td = Benchmark::timediff(Benchmark->new, $t1);
my $tds= Benchmark::timestr($td);
my $dur = $td->cpu_a || (1/$count); # fudge if cpu_a==0
- printf "%d NullP sth/sec on this perl $] %s (%d in %.1f cpu+sys secs)\n\n",
- $count/$dur, $Config{archname}, $count, $dur;
+
+ printf "%5d NullP sth/s perl %8s %s (%s %s %s)\n\n",
+ $count/$dur, $], $Config{archname},
+ $Config{gccversion} ? 'gcc' : $Config{cc},
+ (split / /, $Config{gccversion}||$Config{ccversion}||'')[0],
+ $Config{optimize};
if (0) {
$null_dbh = DBI->connect('dbi:mysql:VC_log','','',{RaiseError=>1});
