Author: timbo
Date: Mon Feb 19 08:10:10 2007
New Revision: 9136
Modified:
dbi/trunk/Changes
dbi/trunk/lib/DBD/Gofer/Transport/pipeone.pm
dbi/trunk/t/10examp.t
dbi/trunk/t/85gofer.t
Log:
t/85gofer.t uses go_perl to ensure correct perl -Mblib=... is used for tests
Enable stream tests for everyone.
Enable stream_ssh tests for me (will later automatically check if ssh works)
Added disgnostics to t/10examp.t re unlinking trace file.
Assorted minor changes.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Feb 19 08:10:10 2007
@@ -7,11 +7,11 @@
=cut
Add attr-passthru to prepare()?
-Guard against version skew.
Terminology
routing %dsn_attr to both transport and DBD::Gofer + warn about unknown ones.
-I could make the short name do a lookup in both DBD::Gofer::Transport and
DBIx::Gofer::Transport.
+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
+Make new connection and retry if send request fails - build into architecture?
=head2 Changes in DBI 1.54 (svn rev 9118), 16th February 2007
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 Mon Feb 19 08:10:10 2007
@@ -64,7 +64,7 @@
# XXX meant to return a prroperly shell-escaped string suitable for system
# but its only for debugging so that can wait
my $connection_info = $self->connection_info;
- return join " ", @{$connection_info->{cmd}};
+ return join " ", map { "'$_'" } @{$connection_info->{cmd}};
}
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Mon Feb 19 08:10:10 2007
@@ -46,7 +46,8 @@
ok( -s $trace_file, "trace file size = " . -s $trace_file);
}
- is( unlink( $trace_file ), 1, "Remove trace file: $trace_file" );
+ my $unlinked = unlink( $trace_file );
+ ok( $unlinked, "Remove trace file $trace_file ($!)" );
ok( !-e $trace_file, "Trace file actually gone" );
DBI->trace($orig_trace_level); # no way to restore previous outfile XXX
Modified: dbi/trunk/t/85gofer.t
==============================================================================
--- dbi/trunk/t/85gofer.t (original)
+++ dbi/trunk/t/85gofer.t Mon Feb 19 08:10:10 2007
@@ -5,6 +5,7 @@
use strict;
use warnings;
+use Cwd;
use Time::HiRes qw(time);
use Data::Dumper;
use Test::More 'no_plan';
@@ -35,27 +36,32 @@
local $ENV{PERL5LIB} = join ":", @INC;
-# XXX add way for a transport to be tested with multiple dsns
-my $username = getpwuid($>);
-my %transports = (
- null => {},
- pipeone => {},
- stream => {},
-# stream => { url => "ssh:[EMAIL PROTECTED]" },
- http => { url => "http://localhost:8001/gofer"; },
+my $getcwd = getcwd();
+my $username = eval { getpwuid($>) } || ''; # fails on windows
+my $can_ssh = ($username && $username eq 'timbo' && -d '.svn');
+
+my %trials = (
+ null => {},
+ pipeone => {},
+ stream => {},
+ stream_ssh => ($can_ssh)
+ ? { url => "ssh:[EMAIL PROTECTED]", perl=>"SAMEPERL
-Mblib=$getcwd/blib" }
+ : undef,
+ http => { url => "http://localhost:8001/gofer"; },
);
-# delete stream test for everyone else because it's to dependent
-# on local configuration issues unrelated to the DBI
-delete $transports{stream} unless $username eq 'timbo' && -d '.svn';
-delete $transports{http} unless $username eq 'timbo' && -d '.svn';
-for my $transport (keys %transports) {
- my $trans_attr = $transports{$transport};
+# too dependant on local config to make a standard test
+delete $trials{http} unless $username eq 'timbo' && -d '.svn';
+
+for my $trial (keys %trials) {
+ (my $transport = $trial) =~ s/_.*//;
+ my $trans_attr = $trials{$trial}
+ or next;
for my $policy_name (qw(pedantic classic rush)) {
eval { run_tests($transport, $trans_attr, $policy_name) };
- ($@) ? fail($@) : pass();
+ ($@) ? fail("$trial: $@") : pass();
}
}
