Tim Bunce wrote:
>
> Replacing the "bootstrap DBI;" line in DBI.pm with "require DBI::PurePerl;"
> and running "make test" may be a good way to play with it.
Another way which makes it easy to go back and forth between real and PP
DBI is to replace "bootstrap DBI;" in DBI.pm with
if (defined $ENV{DBIPP}) {
require "$full_path/PurePerl.pm";
}
else {
bootstrap DBI;
}
And then set $ENV{DBIPP} in the shell or in a script with
BEGIN{$ENV{DBIPP}=1} when you want to test the pure perl version.
> p.s. Jeff, this is the verson I sent you but with the NUM_OF_FIELDS bug fixed.
And here are my latest patches (onto that version).
I've made a number of improvements and recieved these results from
Jochen's extensive DBD::CSV/t/*.t:
Failed 1/14 test scripts, 92.86% okay. 5/244 subtests failed, 97.95%
okay.
All 5 of the subtest failures are related to bind_columns which I
haven't really touched yet so that is looking pretty good.
The patch is attatched below. Here's a summary of changes:
_setup_handle()
* now sets $sth->{Database} and $dbh->{Warn}
_install_method()
* has better error checking and a proper symref for the func() calls
* returns without failing if there is no handle (e.g. during cleanup, or
should it fail?)
Tests with DBI-1.21/t/*.t aren't as good. There are lots of failures
related to DBI::hash() but I haven't looked into them yet.
--
Jeff
-- Start of Patch --
10c10
< my $trace = 1;
---
> my $trace = 0;
127c127
<
---
> no strict qw(refs);
135c135,148
< &$sub($h,@_);
---
> #
> # do proper symref for func()
> #
> $sub = $imp->can($sub)
> or croak "Can't find $method_name method for $h";
> my @ret;
> (wantarray) ? (@ret = &$sub($h,@_)) : (@ret = scalar &$sub($h,@_));
> if ($h->{err}) {
> my $msg = sprintf "$method failed: $h->{errstr}";
> carp $msg if $h->{"PrintError"};
> croak $msg if $h->{"RaiseError"};
> }
> printf TFH " < $method_name(@_)\n" if $trace;
> return (wantarray) ? @ret : $ret[0];
142c155,159
< my $imp = $h->{"ImplementorClass"};
---
> # avoid error from FETCH on undefined handle during cleanup
> #
> my $imp;
> eval { $imp = $h->{"ImplementorClass"} if $h; };
> return unless defined $imp;
160a178,185
> #
> # Remember $dbh for use in $sth->{Database};
> # Remember 'Warn' status (same as PrintError?)
> #
> if ($parent and ref($parent) =~ /DBI::db/ and ref($h) =~ /DBI::st/) {
> $parent->STORE('Warn',$parent->{PrintError});
> $h->STORE('Database',$parent);
> }
303c328
< my ($h, $col, $value_ref) = shift;
---
> my ($h, $col, $value_ref) = @_;
308c333
< *{$fbav->[$col]} = $value_ref;
---
> *{$fbav->[$col]} = $value_ref if defined $fbav->[$col];
