Author: timbo
Date: Thu Mar 8 09:03:58 2007
New Revision: 9215
Modified:
dbi/trunk/Changes
dbi/trunk/goferperf.pl
dbi/trunk/lib/DBD/NullP.pm
dbi/trunk/lib/DBI/Gofer/Transport/Base.pm
dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
Log:
Improve AutoCommit handling in DBD::Null
Improve error handling in Gofer/Transport/Base and mod_perl.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Thu Mar 8 09:03:58 2007
@@ -19,6 +19,8 @@
Call method on transport timeout so transport can cleanup/reset it it wants
XXX quote policy control
prepare(...,{ Err=>\my $isolated_err, ...})
+Profile: autoderef Path elements that are refs (ref to scalar & ref to array)
+ to make it cheap to gather path 'dynamically' from existing dynamic values
=head2 Changes in DBI 1.55 (svn rev XXX), XXX
Modified: dbi/trunk/goferperf.pl
==============================================================================
--- dbi/trunk/goferperf.pl (original)
+++ dbi/trunk/goferperf.pl Thu Mar 8 09:03:58 2007
@@ -70,7 +70,7 @@
printf " %6s %-16s: %.6fsec (%5d/sec)",
$activity, $perf_tag, $dur/$opt_count, $opt_count/$dur;
my $baseline_dur = $stats_hash->{'~baseline~'};
- printf " %+5.1fms", (($dur-$baseline_dur)/$opt_count)*1000
+ printf " %+6.2fms", (($dur-$baseline_dur)/$opt_count)*1000
unless $perf_tag eq '~baseline~';
print "\n";
}
Modified: dbi/trunk/lib/DBD/NullP.pm
==============================================================================
--- dbi/trunk/lib/DBD/NullP.pm (original)
+++ dbi/trunk/lib/DBD/NullP.pm Thu Mar 8 09:03:58 2007
@@ -70,8 +70,6 @@
# In reality this would interrogate the database engine to
# either return dynamic values that cannot be precomputed
# or fetch and cache attribute values too expensive to prefetch.
- return 1 if $attrib eq 'AutoCommit';
- # else pass up to DBI to handle
return $dbh->SUPER::FETCH($attrib);
}
@@ -80,8 +78,10 @@
# would normally validate and only store known attributes
# else pass up to DBI to handle
if ($attrib eq 'AutoCommit') {
- return 1 if $value; # is already set
- Carp::croak("Can't disable AutoCommit");
+ Carp::croak("Can't disable AutoCommit") unless $value;
+ # convert AutoCommit values to magic ones to let DBI
+ # know that the driver has 'handled' the AutoCommit attribute
+ $value = ($value) ? -901 : -900;
}
return $dbh->SUPER::STORE($attrib, $value);
}
Modified: dbi/trunk/lib/DBI/Gofer/Transport/Base.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Transport/Base.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Transport/Base.pm Thu Mar 8 09:03:58 2007
@@ -43,6 +43,7 @@
local $Storable::forgive_me = 1; # for CODE refs etc
my $frozen = eval { nfreeze($data) };
if ($@) {
+ chomp $@;
die "Error freezing ".ref($data)." object: $@";
}
return $frozen;
@@ -52,7 +53,7 @@
my ($self, $frozen_data, $skip_trace) = @_;
my $data = eval { thaw($frozen_data) };
if ($@) {
- my $err = $@;
+ chomp(my $err = $@);
$self->_dump("bad data",$frozen_data);
die "Error thawing object: $err";
}
Modified: dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm Thu Mar 8 09:03:58 2007
@@ -3,19 +3,20 @@
use strict;
use warnings;
+use Sys::Hostname qw(hostname);
use DBI::Gofer::Execute;
-use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and
$ENV{MOD_PERL_API_VERSION} >= 2 );
+use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and
$ENV{MOD_PERL_API_VERSION} >= 2 );
BEGIN {
if (MP2) {
require Apache2::RequestIO;
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::Const;
- Apache2::Const->import(-compile => qw(OK));
+ Apache2::Const->import(-compile => qw(OK SERVER_ERROR));
} else {
require Apache::Constants;
- Apache::Constants->import(qw(OK));
+ Apache::Constants->import(qw(OK SERVER_ERROR));
}
}
@@ -23,6 +24,7 @@
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
+my $hostname = hostname();
my $transport = __PACKAGE__->new();
my %executor_configs = ( default => { } );
@@ -33,15 +35,22 @@
my $self = shift;
my $r = shift;
- my $executor = $executor_cache{ $r->uri } ||= $self->executor_for_uri($r);
+ eval {
+ my $executor = $executor_cache{ $r->uri } ||=
$self->executor_for_uri($r);
- $r->read(my $frozen_request, $r->headers_in->{'Content-length'});
- my $request = $transport->thaw_data($frozen_request);
+ $r->read(my $frozen_request, $r->headers_in->{'Content-length'});
+ my $request = $transport->thaw_data($frozen_request);
- my $response = $executor->execute_request( $request );
+ my $response = $executor->execute_request( $request );
- my $frozen_response = $transport->freeze_data($response);
- print $frozen_response;
+ my $frozen_response = $transport->freeze_data($response);
+ print $frozen_response;
+ };
+ if ($@) {
+ chomp $@;
+ $r->custom_response(SERVER_ERROR, "$@ version $VERSION (DBI
$DBI::VERSION) on $hostname");
+ return SERVER_ERROR;
+ }
return OK;
}
