Author: timbo
Date: Thu Apr 12 13:24:40 2007
New Revision: 9402
Modified:
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/Gofer/Transport/stream.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/11fetch.t
dbi/trunk/t/85gofer.t
Log:
Remove restrictions on altering NUM_OF_FIELDS.
Fix setting NUM_OF_FIELDS to correctly adjust row buffer if value is smaller.
Add tests for altering NUM_OF_FIELDS.
Only automatically reset row count on initial allocation of row buffer.
Fix $/ & $\ in DBI/Gofer/Transport/stream.
Add dbi_time to DBI::PurePerl - integer only for now.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Thu Apr 12 13:24:40 2007
@@ -1403,24 +1403,27 @@
if (DBIc_TRACE_LEVEL(imp_sth) >= 3)
PerlIO_printf(DBILOGFP," dbih_setup_fbav realloc from %ld to
%ld fields\n", av_len(av)+1, i);
SvREADONLY_off(av);
+ if (i < av_len(av)+1) /* trim to size if too big */
+ av_fill(av, i-1);
}
else {
if (DBIc_TRACE_LEVEL(imp_sth) >= 3)
PerlIO_printf(DBILOGFP," dbih_setup_fbav alloc for %ld
fields\n", i);
av = newAV();
DBIc_FIELDS_AV(imp_sth) = av;
+
+ /* row_count will need to be manually reset by the driver if the
*/
+ /* sth is re-executed (since this code won't get rerun)
*/
+ DBIc_ROW_COUNT(imp_sth) = 0;
}
/* load array with writeable SV's. Do this backwards so */
/* the array only gets extended once. */
while(i--) /* field 1 stored at index 0 */
av_store(av, i, newSV(0));
- if (DBIc_TRACE_LEVEL(imp_sth) >= 3)
+ if (DBIc_TRACE_LEVEL(imp_sth) >= 6)
PerlIO_printf(DBILOGFP," dbih_setup_fbav now %ld fields\n",
av_len(av)+1);
SvREADONLY_on(av); /* protect against shift @$row etc */
- /* row_count will need to be manually reset by the driver if the */
- /* sth is re-executed (since this code won't get rerun) */
- DBIc_ROW_COUNT(imp_sth) = 0;
return av;
}
@@ -1736,15 +1739,10 @@
else if (htype==DBIt_ST && strEQ(key, "NUM_OF_FIELDS")) {
D_imp_sth(h);
int new_num_fields = (SvOK(valuesv)) ? SvIV(valuesv) : -1;
-
- if (DBIc_NUM_FIELDS(imp_sth) > 0 /* don't change NUM_FIELDS! */
- && DBIc_ACTIVE(imp_sth) /* if sth is Active */
- ) {
- croak("Can't change NUM_OF_FIELDS of Active handle (already set to
%d)", DBIc_NUM_FIELDS(imp_sth));
- }
DBIc_NUM_FIELDS(imp_sth) = new_num_fields;
- if (DBIc_FIELDS_AV(imp_sth)) /* modify existing fbav */
+ if (DBIc_FIELDS_AV(imp_sth)) { /* modify existing fbav */
dbih_setup_fbav(imp_sth);
+ }
cacheit = 1;
}
else if (htype==DBIt_ST && strEQ(key, "NUM_OF_PARAMS")) {
Modified: dbi/trunk/lib/DBI/Gofer/Transport/stream.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Transport/stream.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Transport/stream.pm Thu Apr 12 13:24:40 2007
@@ -27,8 +27,8 @@
DBI->trace_msg("$0 started (pid $$)\n");
- local $/;
- local $\ = "\012";
+ local $\; # OUTPUT_RECORD_SEPARATOR
+ local $/ = "\012"; # INPUT_RECORD_SEPARATOR
while ( defined( my $encoded_request = <STDIN> ) ) {
$encoded_request =~ s/\015?\012$//;
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Thu Apr 12 13:24:40 2007
@@ -16,9 +16,6 @@
#
########################################################################
-# TODO:
-# recheck code against DBI
-
use strict;
use Carp;
require Symbol;
@@ -634,6 +631,10 @@
return "$quote$v$quote";
}
+sub dbi_time {
+ return time();
+}
+
package
DBI::var;
@@ -731,6 +732,14 @@
$h->trace($value);
return 1;
}
+ elsif ($key eq 'NUM_OF_FIELDS') {
+ $h->{$key} = $value;
+ if ($value) {
+ my $fbav = DBD::_::st::dbih_setup_fbav($h);
+ @$fbav = (undef) x $value if @$fbav != $value;
+ }
+ return 1;
+ }
elsif (!$is_valid_attribute{$key} && $key =~ /^[A-Z]/ && !exists
$h->{$key}) {
Carp::carp(sprintf "Can't set %s->{%s}: unrecognised attribute or
invalid value %s",
$h,$key,$value);
Modified: dbi/trunk/t/11fetch.t
==============================================================================
--- dbi/trunk/t/11fetch.t (original)
+++ dbi/trunk/t/11fetch.t Thu Apr 12 13:24:40 2007
@@ -13,7 +13,7 @@
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
-plan tests => 23;
+plan tests => 24;
my $dbh = DBI->connect("dbi:Sponge:foo","","", {
PrintError => 0,
@@ -98,23 +98,19 @@
warn Dumper \%dump if %dump;
-# test auto repair of NUM_OF_FIELDS if size of row buffer is changed
-# (ie by code incompletely handling multiple result sets)
+# test assignment to NUM_OF_FIELDS automatically alters the row buffer
$sth = go();
my $row = $sth->fetchrow_arrayref;
is scalar @$row, 3;
is $sth->{NUM_OF_FIELDS}, 3;
-if (0) { # manual test as it requires the row buffer to not be readonly
- push @$row, 'newcol'; # force additional column into row buffer
- is scalar @$row, 4;
- # should produce a warning and update NUM_FIELDS
- ok $row = $sth->fetchrow_arrayref;
- is scalar @$row, 4;
- is $sth->{NUM_OF_FIELDS}, 4;
-}
-else {
- ok(1) for (1..4)
-}
+is scalar @{ $sth->_get_fbav }, 3;
+$sth->{NUM_OF_FIELDS} = 4;
+is $sth->{NUM_OF_FIELDS}, 4;
+is scalar @{ $sth->_get_fbav }, 4;
+$sth->{NUM_OF_FIELDS} = 2;
+is $sth->{NUM_OF_FIELDS}, 2;
+is scalar @{ $sth->_get_fbav }, 2;
+
$sth->finish;
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Thu Apr 12 13:24:40 2007
@@ -100,8 +100,8 @@
print "\n";
$stats_hash->{'~baseline~'} = delete $stats_hash->{"no+pedantic"};
for my $perf_tag (reverse sort keys %$stats_hash) {
- my $dur = $stats_hash->{$perf_tag};
- printf " %6s %-13s: %.6fsec (%5d/sec)",
+ my $dur = $stats_hash->{$perf_tag} || 0.0000001;
+ printf " %6s %-16s: %.6fsec (%5d/sec)",
$activity, $perf_tag, $dur/$perf_count, $perf_count/$dur;
my $baseline_dur = $stats_hash->{'~baseline~'};
printf " %+5.1fms", (($dur-$baseline_dur)/$perf_count)*1000
@@ -163,6 +163,7 @@
is_deeply($rowset, { '1' => { dKey=>1, dVal=>'apples' }, 2 => { dKey=>2,
dVal=>'apples' } });
if ($perf_count and $transport ne 'pipeone') {
+ print "performance check - $perf_count selects and inserts\n";
my $start = dbi_time();
$dbh->selectall_arrayref("SELECT dKey, dVal FROM fruit")
for (1000..1000+$perf_count);
@@ -175,20 +176,25 @@
$durations{insert}{"$transport+$policy_name"} = dbi_time() - $start;
}
+ my $skip_go_request_count_check = ($transport eq 'no');
+
print "Testing go_request_count and caching of simple values\n";
my $go_request_count = $dbh->{go_request_count};
- ok $go_request_count;
+ ok $go_request_count
+ unless $skip_go_request_count_check && pass();
ok $dbh->do("DROP TABLE fruit");
- is ++$go_request_count, $dbh->{go_request_count};
+ is ++$go_request_count, $dbh->{go_request_count}
+ unless $skip_go_request_count_check && pass();
- # actuall tests go_request_count, caching, and skip_default_methods policy
+ # tests go_request_count, caching, and skip_default_methods policy
my $use_remote = ($policy->skip_default_methods) ? 0 : 1;
- print "use_remote=$use_remote (policy=$policy_name, transport=$transport)
$dbh->{dbi_default_methods}\n";
+ printf "use_remote=%s (policy=%s, transport=%s) %s\n",
+ $use_remote, $policy_name, $transport, $dbh->{dbi_default_methods}||'';
SKIP: {
skip "skip_default_methods checking doesn't work with Gofer over Gofer", 3
- if $ENV{DBI_AUTOPROXY};
+ if $ENV{DBI_AUTOPROXY} or $skip_go_request_count_check;
$dbh->data_sources({ foo_bar => $go_request_count });
is $dbh->{go_request_count}, $go_request_count + 1*$use_remote;
$dbh->data_sources({ foo_bar => $go_request_count }); # should use cache
