Author: timbo
Date: Thu Feb 15 05:38:58 2007
New Revision: 9110
Modified:
dbi/trunk/Changes
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
dbi/trunk/lib/DBI/Gofer/Request.pm
dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
dbi/trunk/t/85gofer.t
Log:
Make dbh_method_* handling like sth_method_call handling (so we don't need
separate _name and _args)
Fix %xxh_local_store_attrib_if_same_value checks to do the right thing with
undefs.
Remove spurious use lib from t/85gofer.t
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Thu Feb 15 05:38:58 2007
@@ -6,6 +6,10 @@
=cut
+Implement policies
+Add attr-passthru to prepare()
+Add $dbh->private_attribute_info method
+
=head2 Changes in DBI 1.54 (svn rev 8791), 2nd February 2007
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Thu Feb 15 05:38:58 2007
@@ -40,7 +40,7 @@
dbi_connect_closure
dbi_go_execute_unique
);
- our %xxh_local_store_if_same_attrib = map { $_=>1 } qw(
+ our %xxh_local_store_attrib_if_same_value = map { $_=>1 } qw(
Username
dbi_connect_method
);
@@ -160,7 +160,7 @@
$dbh->STORE(Active => 0); # mark as inactive temporarily for STORE
# test the connection XXX control via a policy later
- unless ($dbh->go_dbh_method('ping', undef)) {
+ unless ($dbh->go_dbh_method(undef, 'ping')) {
return undef if $dbh->err; # error already recorded, typically
return $dbh->set_err(1, "ping failed");
}
@@ -189,7 +189,7 @@
{ package DBD::Gofer::db; # ====== DATABASE ======
$imp_data_size = 0;
use strict;
- use Carp qw(croak);
+ use Carp qw(carp croak);
my %dbh_local_store_attrib = %DBD::Gofer::xxh_local_store_attrib;
@@ -198,9 +198,12 @@
}
sub go_dbh_method {
- my ($dbh, $method, $meta, @args) = @_;
+ my $dbh = shift;
+ my $meta = shift;
+ # $method and @args left in @_
+
my $request = $dbh->{go_request};
- $request->init_request($method, [EMAIL PROTECTED], wantarray);
+ $request->init_request([EMAIL PROTECTED], wantarray);
my $transport = $dbh->{go_trans}
or return $dbh->set_err(1, "Not connected (no transport)");
@@ -240,7 +243,7 @@
func
)) {
no strict 'refs';
- *$method = sub { return shift->go_dbh_method($method, undef, @_) }
+ *$method = sub { return shift->go_dbh_method(undef, $method, @_) }
}
# Methods that should always fail
@@ -258,7 +261,7 @@
my $dbh = shift;
delete $dbh->{Statement}; # avoid "Modification of non-creatable hash
value attempted"
$dbh->{Statement} = $_[0]; # for profiling and ShowErrorStatement
- return $dbh->go_dbh_method('do', undef, @_);
+ return $dbh->go_dbh_method(undef, 'do', @_);
}
sub ping {
@@ -266,7 +269,7 @@
return $dbh->set_err(0, "can't ping while not connected") # warning
unless $dbh->SUPER::FETCH('Active');
# XXX local or remote - add policy attribute
- return $dbh->go_dbh_method('ping', undef, @_);
+ return $dbh->go_dbh_method(undef, 'ping', @_);
}
sub last_insert_id {
@@ -281,7 +284,7 @@
# forward driver-private attributes
if ($attrib =~ m/^[a-z]/) { # XXX policy? precache on connect?
- my $value = $dbh->go_dbh_method('FETCH', undef, $attrib);
+ my $value = $dbh->go_dbh_method(undef, 'FETCH', $attrib);
$dbh->{$attrib} = $value;
return $value;
}
@@ -303,11 +306,17 @@
or not $dbh->FETCH('Active');
return $dbh->SUPER::STORE($attrib => $value)
- if $DBD::Gofer::xxh_local_store_if_same_attrib{$attrib}
- && do { local $^W; $value eq $dbh->FETCH($attrib) }; # XXX undefs
+ if $DBD::Gofer::xxh_local_store_attrib_if_same_value{$attrib}
+ && do { # return true if values are the same
+ my $crnt = $dbh->FETCH($attrib);
+ local $^W;
+ (defined($value) ^ defined($crnt))
+ ? 0 # definedness differs
+ : $value eq $crnt;
+ };
# dbh attributes are set at connect-time - see connect()
- Carp::carp("Can't alter \$dbh->{$attrib}") if $dbh->FETCH('Warn');
+ carp("Can't alter \$dbh->{$attrib}") if $dbh->FETCH('Warn');
return $dbh->set_err(1, "Can't alter \$dbh->{$attrib}");
}
@@ -329,18 +338,18 @@
my ($sth, $sth_inner) = DBI::_new_sth($dbh, {
Statement => $statement,
- go_prepare_call => [ 'prepare', [ $statement, $attr ] ],
+ go_prepare_call => [ 'prepare', $statement, $attr ],
go_method_calls => [],
go_request => $dbh->{go_request},
go_trans => $dbh->{go_trans},
go_policy => $policy,
});
- #my $p_sep = $policy->skip_early_prepare($attr, $dbh, $statement,
$attr, $sth);
- my $p_sep = 0;
+ #my $skip_early_prepare = $policy->skip_early_prepare($attr, $dbh,
$statement, $attr, $sth);
+ my $skip_early_prepare = 0;
- $p_sep = 1 if not defined $statement; # XXX hack, see go_dbh_method
- if (not $p_sep) {
+ $skip_early_prepare = 1 if not defined $statement; # XXX hack, see
go_dbh_method
+ if (not $skip_early_prepare) {
$sth->go_sth_method() or return undef;
}
@@ -369,7 +378,7 @@
}
my $request = $sth->{go_request};
- $request->init_request(@{$sth->{go_prepare_call}}, undef);
+ $request->init_request($sth->{go_prepare_call}, undef);
$request->sth_method_calls($sth->{go_method_calls});
$request->sth_result_attr({});
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Thu Feb 15 05:38:58 2007
@@ -211,8 +211,8 @@
my $dbh;
my $rv_ref = eval {
$dbh = $self->_connect($request);
- my $meth = $request->dbh_method_name;
- my $args = $request->dbh_method_args;
+ my $args = $request->dbh_method_call; # [ 'method_name', @args ]
+ my $meth = shift @$args;
my @rv = ($request->dbh_wantarray)
? $dbh->$meth(@$args)
: scalar $dbh->$meth(@$args);
@@ -243,8 +243,8 @@
my $rv = eval {
$dbh = $self->_connect($request);
- my $meth = $request->dbh_method_name;
- my $args = $request->dbh_method_args;
+ my $args = $request->dbh_method_call; # [ 'method_name', @args ]
+ my $meth = shift @$args;
$sth = $dbh->$meth(@$args);
my $last = '(sth)'; # a true value (don't try to return actual sth)
Modified: dbi/trunk/lib/DBI/Gofer/Request.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Request.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Request.pm Thu Feb 15 05:38:58 2007
@@ -14,8 +14,7 @@
__PACKAGE__->mk_accessors(qw(
connect_args
- dbh_method_name
- dbh_method_args
+ dbh_method_call
dbh_wantarray
dbh_last_insert_id_args
sth_method_calls
@@ -33,10 +32,9 @@
}
sub init_request {
- my ($self, $method, $args_ref, $wantarray) = @_;
+ my ($self, $method_and_args, $wantarray) = @_;
$self->reset;
- $self->dbh_method_name($method);
- $self->dbh_method_args($args_ref);
+ $self->dbh_method_call($method_and_args);
$self->dbh_wantarray($wantarray);
}
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 Feb 15 05:38:58 2007
@@ -82,7 +82,7 @@
}
-sub configuration { # one-time setup from httpd.conf
+sub configuration { # one-time setup from httpd.conf
my ($self, $configs) = @_;
while ( my ($config_name, $config) = each %$configs ) {
my @bad = grep { not exists $proto_config->{$_} } keys %$config;
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Thu Feb 15 05:38:58 2007
@@ -9,8 +9,6 @@
use DBI;
-use lib "/Users/timbo/dbi/trunk/lib";
-
# so users can try others from the command line
my $dbm = $ARGV[0] || "SDBM_File";
