Author: timbo
Date: Wed Apr 25 08:57:06 2007
New Revision: 9451
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/goferperf.pl
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBD/Gofer/Transport/Base.pm
dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
dbi/trunk/lib/DBI/Gofer/Request.pm
dbi/trunk/lib/DBI/Gofer/Response.pm
dbi/trunk/test.pl
Log:
Partial work on retry mechanism for gofer.
Added flags field to response, with GOf_RESPONSE_EXECUTED set if
$dbh->{Executed}
so if the flags not set then the client knows it can safely retry.
Removed dbh_wantarray from request by moving it into dbh_method_call.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Apr 25 08:57:06 2007
@@ -6,8 +6,6 @@
=cut
-http://buildd.debian.org/fetch.cgi?&pkg=libdbi-perl&ver=1.54-1&arch=m68k&stamp=1174636818&file=log
-
Policy principle:
Designed to influence behaviour of unaltered programs
ie go_* attributes take precidence over policy
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Wed Apr 25 08:57:06 2007
@@ -3082,7 +3082,7 @@
Returns a state code in the standard SQLSTATE five character format.
Note that the specific success code C<00000> is translated to any empty string
(false). If the driver does not support SQLSTATE (and most don't),
-then state will return C<S1000> (General Error) for all errors.
+then state() will return C<S1000> (General Error) for all errors.
The driver is free to return any value via C<state>, e.g., warning
codes, even if it has not declared an error by returning a true value
@@ -3090,7 +3090,7 @@
The state() method should not be used to test for errors, use err()
for that, because drivers may return a 'success with information' or
-warning state code via errstr() for methods that have not 'failed'.
+warning state code via state() for methods that have not 'failed'.
=item C<set_err>
Modified: dbi/trunk/goferperf.pl
==============================================================================
--- dbi/trunk/goferperf.pl (original)
+++ dbi/trunk/goferperf.pl Wed Apr 25 08:57:06 2007
@@ -14,7 +14,7 @@
GetOptions(
'c|count=i' => \(my $opt_count = 100),
- 'dsn=s' => \(my $opt_dsn = "dbi:NullP:"),
+ 'dsn=s' => \(my $opt_dsn),
'timeout=i' => \(my $opt_timeout = 10),
'p|policy=s' => \(my $opt_policy = "pedantic,classic,rush"),
) or exit 1;
@@ -38,6 +38,7 @@
my %trials = (
null => {},
+ null_ha => { DBI => "DBIx::HA" },
pipeone => { perl=>$perl, timeout=>$opt_timeout },
stream => { perl=>$perl, timeout=>$opt_timeout },
stream_ssh => ($can_ssh)
@@ -80,19 +81,23 @@
sub run_tests {
my ($transport, $trans_attr, $policy_name) = @_;
- my $test_run_tag = "Testing $transport transport with $policy_name policy";
+ my $connect_attr = delete $trans_attr->{connect_attr} || {};
+ my $DBI = delete $trans_attr->{DBI} || "DBI";
+ _load_class($DBI) if $DBI ne "DBI";
+
+ my $test_run_tag = "Testing $transport transport with $policy_name policy
@{[ %$connect_attr ]}";
print "\n$test_run_tag\n";
- my $dsn = $opt_dsn;
+ my $dsn = $opt_dsn || $trans_attr->{dsn} || "dbi:NullP:";
if ($policy_name ne 'no') {
my $driver_dsn = "transport=$transport;policy=$policy_name";
$driver_dsn .= join ";", '', map { "$_=$trans_attr->{$_}" } keys
%$trans_attr
if %$trans_attr;
- $dsn = "dbi:Gofer:$driver_dsn;dsn=$opt_dsn";
+ $dsn = "dbi:Gofer:$driver_dsn;dsn=$dsn";
}
print " $dsn\n";
- my $dbh = DBI->connect($dsn, undef, undef, { RaiseError => 1 } );
+ my $dbh = $DBI->connect($dsn, undef, undef, { %$connect_attr, RaiseError
=> 1 } );
$dbh->do("DROP TABLE IF EXISTS fruit");
$dbh->do("CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))");
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Wed Apr 25 08:57:06 2007
@@ -251,7 +251,7 @@
# $method and @args left in @_
my $request = $dbh->{go_request};
- $request->init_request([EMAIL PROTECTED], wantarray);
+ $request->init_request([ wantarray, @_ ]);
++$dbh->{go_request_count};
my $go_policy = $dbh->{go_policy};
@@ -506,7 +506,7 @@
my ($sth, $sth_inner) = DBI::_new_sth($dbh, {
Statement => $statement,
- go_prepare_call => [ $go_prepare, $statement, $attr ],
+ go_prepare_call => [ 0, $go_prepare, $statement, $attr ],
# go_method_calls => [], # autovivs if needed
go_request => $dbh->{go_request},
go_transport => $dbh->{go_transport},
@@ -567,7 +567,7 @@
++$dbh->{go_request_count};
my $request = $sth->{go_request};
- $request->init_request($sth->{go_prepare_call}, undef);
+ $request->init_request($sth->{go_prepare_call});
$request->sth_method_calls(delete $sth->{go_method_calls})
if $sth->{go_method_calls};
$request->sth_result_attr({}); # (currently) also indicates this is an
sth request
Modified: dbi/trunk/lib/DBD/Gofer/Transport/Base.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer/Transport/Base.pm (original)
+++ dbi/trunk/lib/DBD/Gofer/Transport/Base.pm Wed Apr 25 08:57:06 2007
@@ -26,27 +26,34 @@
sub transmit_request {
my ($self, $request) = @_;
-
my $to = $self->go_timeout;
- local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
- my $info = eval {
- local $SIG{PIPE} = sub {
- my $extra = ($! eq "Broken pipe") ? "" : " ($!)";
- die "Unable to send request: Broken pipe$extra\n";
+ my $transmit_sub = sub {
+ local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
+
+ my $info = eval {
+ local $SIG{PIPE} = sub {
+ my $extra = ($! eq "Broken pipe") ? "" : " ($!)";
+ die "Unable to send request: Broken pipe$extra\n";
+ };
+ alarm($to) if $to;
+ $self->transmit_request_by_transport($request);
};
- alarm($to) if $to;
- $self->transmit_request_by_transport($request);
+ alarm(0) if $to;
+
+ if ($@) {
+ return $self->transport_timedout("transmit_request", $to)
+ if $@ eq "TIMEOUT\n";
+ return DBI::Gofer::Response->new({ err => 1, errstr => $@ });
+ }
+
+ return undef;
};
- alarm(0) if $to;
- if ($@) {
- return $self->transport_timedout("transmit_request", $to)
- if $@ eq "TIMEOUT\n";
- return DBI::Gofer::Response->new({ err => 1, errstr => $@ });
- }
+ my $response = $transmit_sub->();
- return undef;
+ return $response unless wantarray;
+ return ($response, $transmit_sub);
}
Modified: dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm (original)
+++ dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm Wed Apr 25 08:57:06 2007
@@ -132,7 +132,7 @@
for my $fh (@readable) {
local $_;
my $actions = $fh_actions->{$fh} || die "panic: no action for $fh";
- my $rv = sysread($fh, $_='', 512 * 32);
+ my $rv = sysread($fh, $_='', 1024*31); # to fit in 32KB slab
unless ($rv) { # error (undef) or end of file (0)
my $action;
unless (defined $rv) { # was an error
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Wed Apr 25 08:57:06 2007
@@ -1273,7 +1273,7 @@
/* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */
DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */
- DBIS->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0,
+ DBIc_STATE(imp_xxh)->set_attr_k(sth,
sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0,
sv_2mortal(newSViv(mysql_num_fields(imp_sth->result)))
);
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Wed Apr 25 08:57:06 2007
@@ -23,6 +23,9 @@
our $local_log = $ENV{DBI_GOFER_LOCAL_LOG}; # do extra logging to stderr
+our $current_dbh; # the dbh we're using for this request
+
+
# set trace for server-side gofer
# Could use DBI_TRACE env var when it's an unrelated separate process
# but using DBI_GOFER_TRACE makes testing easier for subprocesses (eg stream)
@@ -165,6 +168,10 @@
# RaiseError must be enabled
RaiseError => 1,
+ # reset Executed flag (of the cached handle) so we can use it to tell
+ # if errors happened before the main part of the request was executed
+ Executed => 0,
+
# ensure this connect_cached doesn't have the same args as the client
# because that causes subtle issues if in the same process (ie
transport=null)
# include pid to avoid problems with forking (ie null transport in
mod_perl)
@@ -178,6 +185,7 @@
}
#$dbh->trace(0);
+ $current_dbh = $dbh;
return $dbh;
}
@@ -189,7 +197,7 @@
sub new_response_with_err {
- my ($self, $rv, $eval_error) = @_;
+ my ($self, $rv, $eval_error, $h) = @_;
# capture err+errstr etc and merge in $eval_error ($@)
my ($err, $errstr, $state) = ($DBI::err, $DBI::errstr, $DBI::state);
@@ -203,11 +211,15 @@
$errstr = ($errstr) ? "$errstr; $eval_error" : $eval_error;
}
+ my $flags;
+ $flags |= GOf_RESPONSE_EXECUTED if $h && $h->{Executed};
+
my $response = DBI::Gofer::Response->new({
rv => $rv,
err => $err,
errstr => $errstr,
state => $state,
+ flags => $flags,
});
return $response;
@@ -238,7 +250,8 @@
? $self->execute_sth_request($request)
: $self->execute_dbh_request($request);
};
- $response ||= $self->new_response_with_err(undef, $@);
+ $response ||= $self->new_response_with_err(undef, $@, $current_dbh);
+ undef $current_dbh;
$response->warnings([EMAIL PROTECTED]) if @warnings;
DBI->trace_msg("<----- execute_request\n");
@@ -254,14 +267,15 @@
my $rv_ref = eval {
$dbh = $self->_connect($request);
my $args = $request->dbh_method_call; # [ 'method_name', @args ]
- my $meth = shift @$args;
+ my $wantarray = shift @$args;
+ my $meth = shift @$args;
$stats->{method_calls_dbh}->{$meth}++;
- my @rv = ($request->dbh_wantarray)
+ my @rv = ($wantarray)
? $dbh->$meth(@$args)
: scalar $dbh->$meth(@$args);
[EMAIL PROTECTED];
} || [];
- my $response = $self->new_response_with_err($rv_ref, $@);
+ my $response = $self->new_response_with_err($rv_ref, $@, $dbh);
return $response if not $dbh;
@@ -342,7 +356,8 @@
my $rv = eval {
$dbh = $self->_connect($request);
- my $args = $request->dbh_method_call; # [ 'method_name', @args ]
+ my $args = $request->dbh_method_call; # [ wantarray, 'method_name',
@args ]
+ shift @$args; # discard wantarray
my $meth = shift @$args;
$stats->{method_calls_sth}->{$meth}++;
$sth = $dbh->$meth(@$args);
@@ -364,7 +379,7 @@
$last;
};
- my $response = $self->new_response_with_err($rv, $@);
+ my $response = $self->new_response_with_err($rv, $@, $dbh);
return $response if not $dbh;
Modified: dbi/trunk/lib/DBI/Gofer/Request.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Request.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Request.pm Wed Apr 25 08:57:06 2007
@@ -20,7 +20,6 @@
version
dbh_connect_call
dbh_method_call
- dbh_wantarray
dbh_attributes
dbh_last_insert_id_args
sth_method_calls
@@ -46,10 +45,9 @@
}
sub init_request {
- my ($self, $method_and_args, $wantarray) = @_;
+ my ($self, $method_and_args) = @_;
$self->reset;
$self->dbh_method_call($method_and_args);
- $self->dbh_wantarray($wantarray);
}
sub summary_as_text {
Modified: dbi/trunk/lib/DBI/Gofer/Response.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Response.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Response.pm Wed Apr 25 08:57:06 2007
@@ -12,16 +12,22 @@
use Carp;
use DBI qw(neat neat_list);
-use base qw(DBI::Util::_accessor);
+use base qw(DBI::Util::_accessor Exporter);
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
+use constant GOf_RESPONSE_EXECUTED => 0x0001;
+
+our @EXPORT = qw(GOf_RESPONSE_EXECUTED);
+
+
__PACKAGE__->mk_accessors(qw(
version
rv
err
errstr
state
+ flags
last_insert_id
dbh_attributes
sth_resultsets
@@ -90,6 +96,8 @@
my @s = sprintf("\trv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
$s[-1] .= sprintf(", err=%s, errstr=%s", $err, neat($errstr))
if defined $err;
+ $s[-1] .= sprintf(", flags=0x%x", $self->{flags})
+ if defined $self->{flags};
push @s, "last_insert_id=%s", $self->last_insert_id
if defined $self->last_insert_id;
Modified: dbi/trunk/test.pl
==============================================================================
--- dbi/trunk/test.pl (original)
+++ dbi/trunk/test.pl Wed Apr 25 08:57:06 2007
@@ -102,6 +102,7 @@
my $null_dbh = DBI->connect('dbi:NullP:','','');
my $null_sth = $null_dbh->prepare(''); # create one to warm up
$count = 20_000;
+ $count /= 10 if $ENV{DBI_AUTOPROXY};
my $i = $count;
my $t1 = new Benchmark;
$null_dbh->prepare('') while $i--;
