Author: timbo
Date: Tue Feb 20 14:58:25 2007
New Revision: 9143
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/lib/DBD/ExampleP.pm
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm
dbi/trunk/lib/DBD/Gofer/Transport/stream.pm
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
dbi/trunk/lib/DBI/Gofer/Response.pm
dbi/trunk/t/85gofer.t
Log:
Move go_perl and related logic down from stream into pipeone.
(SAMEPERL concept should be probably be removed now)
Added private_attribute_info to DBD::ExampleP (not tested yet)
Tweaked some DBD::Gofer docs
Chomp errstr in new() Response.
Refactor private_attribute_info logic into new sub with caching.
Added policy=pedantic to xgp test variants.
Added perl attribute to pipeone t/85gofer.t transport tests.
Sort t/85gofer.t to (handling, currently) put null first.
Released as RC7
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Feb 20 14:58:25 2007
@@ -10,6 +10,11 @@
Terminology for client and server ends
I could make the short transport/policy name do a lookup in both
DBD::Gofer::Transport and DBIx::Gofer::Transport.
Document user/passwd issues at the various levels of the stack
+is_sth_request via dbh_method_call->[0] =~ /^prepare/?
+Policy for dbh attr FETCH (ie example_driver_path)
+ or piggyback on skip_connect_check
+ could also remember which attr have been returned to us
+ so not bother FETCHing them (unless pedantic)
=head2 Changes in DBI 1.54 (svn rev 9140), 19th February 2007
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Tue Feb 20 14:58:25 2007
@@ -3257,11 +3257,11 @@
=item C<private_attribute_info>
- $array_ref = $h->private_attribute_info();
+ $hash_ref = $h->private_attribute_info();
-Returns a reference to an array containing the names of driver-private
-attributes available for that kind of handle (driver, database, statement),
-or else undef.
+Returns a reference to a hash whose keys are the names of driver-private
+attributes available for that kind of handle (driver, database, statement).
+(The values should be undef. Meanings may be assigned to particular values in
future.)
=item C<swap_inner_handle>
Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm Tue Feb 20 14:58:25 2007
@@ -274,6 +274,9 @@
return $h->SUPER::parse_trace_flag($name);
}
+ sub private_attribute_info {
+ return { example_driver_path => undef };
+ }
}
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Tue Feb 20 14:58:25 2007
@@ -120,10 +120,10 @@
$policy_class = "DBD::Gofer::Policy::$policy_class"
unless $policy_class =~ /::/;
_load_class($policy_class)
- or return $drh->set_err(1, "Error loading $policy_class: $@");
+ or return $drh->set_err(1, "Can't load $policy_class: $@");
# replace policy name in %go_attr with policy object
$go_attr{go_policy} = eval { $policy_class->new(\%go_attr) }
- or return $drh->set_err(1, "Error instanciating $policy_class:
$@");
+ or return $drh->set_err(1, "Can't instanciate $policy_class:
$@");
}
# policy object is left in $go_attr{go_policy} so transport can see it
my $go_policy = $go_attr{go_policy};
@@ -133,9 +133,9 @@
$transport_class = "DBD::Gofer::Transport::$transport_class"
unless $transport_class =~ /::/;
_load_class($transport_class)
- or return $drh->set_err(1, "Error loading $transport_class: $@");
+ or return $drh->set_err(1, "Can't load $transport_class: $@");
my $go_trans = eval { $transport_class->new(\%go_attr) }
- or return $drh->set_err(1, "Error instanciating $transport_class:
$@");
+ or return $drh->set_err(1, "Can't instanciate $transport_class:
$@");
my $request_class = "DBI::Gofer::Request";
my $go_request = eval {
@@ -150,7 +150,7 @@
$request_class->new({
connect_args => [ $remote_dsn, $go_attr ]
})
- } or return $drh->set_err(1, "Error instanciating $request_class $@");
+ } or return $drh->set_err(1, "Can't instanciate $request_class $@");
my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
'Name' => $dsn,
@@ -394,7 +394,7 @@
}
}
- my $dbh = $sth->{Database} or die 42; # XXX
+ my $dbh = $sth->{Database} or die "panic";
++$dbh->{go_request_count};
my $request = $sth->{go_request};
@@ -677,7 +677,7 @@
=head2 You can't call driver-private sth methods
-But few people need to do that.
+But that's rarely needed anyway.
=head2 Array Methods are not supported
@@ -690,17 +690,17 @@
=head2 Driver-private Database Handle Attributes
-Some driver-private dbh attributes may not be available, currently.
-In future it will be possible to indicate which attributes you'd like to be
-able to read.
+Driver-private drh attributes can be set in the connect() call.
+
+Some driver-private dbh attributes may not be available if the driver does not
+implemented the private_attribute_info() method (added in DBI 1.54).
=head2 Driver-private Statement Handle Attributes
Driver-private sth attributes can be set in the prepare() call. TODO
-Some driver-private sth attributes may not be available, currently.
-In future it will be possible to indicate which attributes you'd like to be
-able to read.
+Some driver-private dbh attributes may not be available if the driver does not
+implemented the private_attribute_info() method (added in DBI 1.54).
=head1 Multiple Resultsets
@@ -736,9 +736,14 @@
DBD::Gofer::Transport::<foo>
DBI::Gofer::Transport::<foo>
+Sometimes the transports on the DBD and DBI sides may have different names. For
+example DBD::Gofer::Transport::http is typically used with
DBI::Gofer::Transport::mod_perl
+
+=head2 Bundled Transports
+
Several transport modules are provided with DBD::Gofer:
-=head2 null
+=head3 null
The null transport is the simplest of them all. It doesn't actually transport
the request anywhere.
It just serializes (freezes) the request into a string, then thaws it back into
@@ -751,7 +756,7 @@
It doesn't take any parameters.
-=head2 pipeone
+=head3 pipeone
The pipeone transport launches a subprocess for each request. It passes in the
request and reads the response. The fact that a new subprocess is started for
@@ -761,7 +766,7 @@
It doesn't take any parameters.
-=head2 stream
+=head3 stream
The stream driver also launches a subprocess and writes requests and reads
responses, like the pipeone transport. In this case, however, the subprocess
@@ -772,15 +777,25 @@
to easily access any databases that's accessible from any system you can login
to.
You also get all the benefits of ssh, including encryption and optional
compression.
+It's also likely that this transport will support safe timeouts in future.
+
See L</DBI_AUTOPROXY> below for an example.
-=head2 http
+=head3 http
The http driver uses the http protocol to send Gofer requests and receive
replies.
The DBI::Gofer::Transport::mod_perl module implements the corresponding
server-side
transport.
+=head2 Other Transports
+
+I know Ask Bj�rn Hansen has implemented a transport for the gearman distributed
+job system. (Not yet on CPAN.)
+
+Implementing a transport is very simple, and more transports are very welcome.
+Just take a look at any existing transports that are similar to your needs.
+
=head1 CONNECTING
Simply prefix your existing DSN with "C<dbi:Gofer:transport=$transport;dsn=>"
@@ -842,10 +857,12 @@
Document policy mechanism
-Add mecahism for transports to list config params and for Gofer to apply any
that match (and warn if any left over?)
+Add mechanism for transports to list config params and for Gofer to apply any
that match (and warn if any left over?)
Driver-private sth attributes - set via prepare() - change DBI spec
+Timeout for stream and http drivers.
+
Caching of get_info values
prepare vs prepare_cached
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 Tue Feb 20 14:58:25 2007
@@ -21,6 +21,7 @@
__PACKAGE__->mk_accessors(qw(
connection_info
response_info
+ go_perl
));
@@ -29,13 +30,32 @@
if $^O ne 'VMS' && $this_perl !~ m/$Config{_exe}$/i;
+sub new {
+ my ($self, $args) = @_;
+ if ($args->{go_perl} and not ref $args->{go_perl}) {
+ # user can override the perl to be used, either with an array ref
+ # containing the command name and args to use, or with a string
+ # (ie via the DSN) in which case, to enable args to be passed,
+ # we split on two or more consecutive spaces (otherwise the path
+ # to perl couldn't contain a space itself).
+ $args->{go_perl} = [ split /\s{2,}/, $args->{go_perl} ];
+ }
+ return $self->SUPER::new($args);
+}
+
+
sub start_pipe_command {
my ($self, $cmd) = @_;
$cmd = [ $cmd ] unless ref $cmd eq 'ARRAY';
# translate any SAMEPERL in cmd to $this_perl
- $_ eq 'SAMEPERL' and $_ = $this_perl
- for @$cmd;
+ my $perl = $self->go_perl || [ $this_perl ];
+ for (my $i=0; $i < @$cmd; $i++) {
+ next unless $cmd->[$i] eq 'SAMEPERL';
+ splice @$cmd, $i, 1, @$perl;
+ $i += @$perl - 1;
+ }
+ $_ eq 'SAMEPERL' and $_ = $this_perl for @$cmd;
# if it's important that the subprocess uses the same
# (versions of) modules as us then the caller should
Modified: dbi/trunk/lib/DBD/Gofer/Transport/stream.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer/Transport/stream.pm (original)
+++ dbi/trunk/lib/DBD/Gofer/Transport/stream.pm Tue Feb 20 14:58:25 2007
@@ -18,7 +18,6 @@
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
__PACKAGE__->mk_accessors(qw(
- go_perl
go_persist
));
@@ -28,19 +27,6 @@
sub nonblock;
-sub new {
- my ($self, $args) = @_;
- if ($args->{go_perl} and not ref $args->{go_perl}) {
- # user can override the perl to be used, either with an array ref
- # containing the command name and args to use, or with a string
- # (ie via the DSN) in which case, to enable args to be passed,
- # we split on two or more consecutive spaces (otherwise the path
- # to perl couldn't contain a space itself).
- $args->{go_perl} = [ split /\s{2,}/, $args->{go_perl} ];
- }
- return $self->SUPER::new($args);
-}
-
sub _connection_key {
my ($self) = @_;
@@ -98,7 +84,7 @@
my ($self) = @_;
my $cmd = [qw(SAMEPERL -MDBI::Gofer::Transport::stream -e run_stdio_hex)];
- if (my $perl = $self->go_perl) {
+ if (0 and my $perl = $self->go_perl) {
splice @$cmd, 0, 1, @$perl;
}
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Tue Feb 20 14:58:25 2007
@@ -3017,7 +3017,7 @@
add => [ q{$ENV{DBI_AUTOPROXY} =
'dbi:Gofer:transport=null;policy=pedantic'} ],
},
xgp => { name => "PurePerl & Gofer",
- add => [ q{$ENV{DBI_PUREPERL} = 2; $ENV{DBI_AUTOPROXY}
= 'dbi:Gofer:transport=null'} ],
+ add => [ q{$ENV{DBI_PUREPERL} = 2; $ENV{DBI_AUTOPROXY}
= 'dbi:Gofer:transport=null;policy=pedantic'} ],
},
# mx => { name => "DBD::Multiplex",
# add => [ q{local $ENV{DBI_AUTOPROXY} =
'dbi:Multiplex:';} ],
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Tue Feb 20 14:58:25 2007
@@ -48,6 +48,7 @@
my %extra_attr = (
# what driver-specific attributes should be returned for the driver being
used?
+ # Only referenced if the driver doesn't support private_attribute_info
method.
# keyed by $dbh->{Driver}{Name}
# XXX for dbh attr only need to be returned on first access by client
# the client should then cache them. So need a way to indicate that.
@@ -232,12 +233,7 @@
my @req_attr_names = @$dbh_attributes;
if ($req_attr_names[0] eq '*') { # auto include std + private
shift @req_attr_names;
- # add ChopBlanks LongReadLen LongTruncOk because drivers may have
different defaults
- # plus Name so the client gets the real Name of the connection
- push @req_attr_names, qw(ChopBlanks LongReadLen LongTruncOk Name);
- my $pai = $dbh->private_attribute_info
- || $extra_attr{ $dbh->{Driver}{Name} }{dbh} || [];
- push @req_attr_names, @$pai;
+ push @req_attr_names, @{ $self->_get_std_attributes($dbh) };
}
my %dbh_attr_values;
$dbh_attr_values{$_} = $dbh->FETCH($_) for @req_attr_names;
@@ -264,6 +260,27 @@
}
+sub _get_std_attributes {
+ my ($self, $h) = @_;
+ $h = tied(%$h) || $h; # switch to inner handle
+ my $attr_names = $h->{private_gofer_std_attr_names};
+ return $attr_names if $attr_names;
+ # add ChopBlanks LongReadLen LongTruncOk because drivers may have
different defaults
+ # plus Name so the client gets the real Name of the connection
+ my @attr_names = qw(ChopBlanks LongReadLen LongTruncOk Name);
+ if (my $pai = $h->private_attribute_info) {
+ push @attr_names, keys %$pai;
+ }
+ elsif (my $drh = $h->{Driver}) { # is a dbh
+ push @attr_names, @{ $extra_attr{ $drh->{Name} }{dbh} || []};
+ }
+ elsif ($drh = $h->{Driver}{Database}) { # is an sth
+ push @attr_names, @{ $extra_attr{ $drh->{Name} }{sth} || []};
+ }
+ return $h->{private_gofer_std_attr_names} = [EMAIL PROTECTED];
+}
+
+
sub execute_sth_request {
my ($self, $request) = @_;
my $dbh;
Modified: dbi/trunk/lib/DBI/Gofer/Response.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Response.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Response.pm Tue Feb 20 14:58:25 2007
@@ -27,6 +27,7 @@
sub new {
my ($self, $args) = @_;
$args->{version} ||= $VERSION;
+ chomp $args->{errstr} if $args->{errstr};
return $self->SUPER::new($args);
}
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Tue Feb 20 14:58:25 2007
@@ -47,13 +47,14 @@
my $getcwd = getcwd();
my $username = eval { getpwuid($>) } || ''; # fails on windows
my $can_ssh = ($username && $username eq 'timbo' && -d '.svn');
+my $perl = "SAMEPERL -Mblib=$getcwd/blib"; # ensure sameperl and our blib
(note two spaces)
my %trials = (
null => {},
- pipeone => {},
- stream => {},
+ pipeone => { perl=>$perl },
+ stream => { perl=>$perl },
stream_ssh => ($can_ssh)
- ? { url => "ssh:[EMAIL PROTECTED]", perl=>"SAMEPERL
-Mblib=$getcwd/blib" }
+ ? { perl=>$perl, url => "ssh:[EMAIL PROTECTED]" }
: undef,
http => { url => "http://localhost:8001/gofer"; },
);
@@ -61,11 +62,14 @@
# too dependant on local config to make a standard test
delete $trials{http} unless $username eq 'timbo' && -d '.svn';
-for my $trial (keys %trials) {
+for my $trial (sort keys %trials) {
(my $transport = $trial) =~ s/_.*//;
my $trans_attr = $trials{$trial}
or next;
+ # XXX temporary restriction, hopefully
+ next if $transport eq 'stream' and $^O eq 'MSWin32'; # need Fcntl macro
F_GETFL for non-blocking
+
for my $policy_name (qw(pedantic classic rush)) {
eval { run_tests($transport, $trans_attr, $policy_name) };
@@ -109,7 +113,7 @@
print " $dsn\n";
my $dbh = DBI->connect($dsn, undef, undef, { } );
- ok $dbh, 'should connect';
+ ok $dbh, sprintf "should connect to %s (%s)", $dsn, $DBI::errstr||'';
die "$test_run_tag aborted\n" unless $dbh;
is $dbh->{Name}, ($policy->skip_connect_check or
$policy->dbh_attribute_update eq 'none')
