[Bps-public-commit] r12268 - in TAP-Harness-Remote: .
alexmv at bestpractical.com
alexmv at bestpractical.com
Mon May 12 16:30:24 EDT 2008
Author: alexmv
Date: Mon May 12 16:30:23 2008
New Revision: 12268
Modified:
TAP-Harness-Remote/ (props changed)
TAP-Harness-Remote/lib/TAP/Harness/Remote.pm
Log:
r31567 at kohr-ah: chmrr | 2008-05-12 16:30:14 -0400
* Mention --state=save,slow
* More sanity checks for config file
* perltidy
Modified: TAP-Harness-Remote/lib/TAP/Harness/Remote.pm
==============================================================================
--- TAP-Harness-Remote/lib/TAP/Harness/Remote.pm (original)
+++ TAP-Harness-Remote/lib/TAP/Harness/Remote.pm Mon May 12 16:30:23 2008
@@ -18,7 +18,7 @@
=head1 SYNOPSIS
- prove --harness TAP::Harness::Remote t/*.t
+ prove -l --state=save,slow --harness TAP::Harness::Remote t/*.t
=head1 DESCRIPTION
@@ -37,13 +37,13 @@
F<~/.remote_test> file:
---
+ ssh: /usr/bin/ssh
local: /path/to/local/testing/root/
+ user: username
host: remote.testing.host.example.com
root: /where/to/place/local/root/on/remote/
- user: username
- master: 1
perl: /usr/bin/perl
- ssh: /usr/bin/ssh
+ master: 1
ssh_args:
- -x
- -S
@@ -75,6 +75,11 @@
distributed in a round-robin manner across the hosts. Each host will
run as many tests in parallel as you specified with C<-j>.
+Especially when running tests in parallel, it is highly suggested that
+you use the standard L<TAP::Harness> C<--state=save,slow> option, as
+this ensures that the slowest tests will run first, reducing your
+overall test run time.
+
=head1 METHODS
=head2 new
@@ -86,20 +91,34 @@
sub new {
my $class = shift;
- my $self = $class->SUPER::new(@_);
+ my $self = $class->SUPER::new(@_);
$self->load_remote_config;
- die "Local testing root (@{[$self->remote_config('local')]}) doesn't exist\n"
- unless -d $self->remote_config("local");
- my $change = File::Spec->abs2rel(Cwd::cwd, $self->remote_config("local"));
- die "Current path isn't inside of local testing root (@{[$self->remote_config('local')]})\n"
- if $change =~ /^\.\./;
+ die
+ "Local testing root (@{[$self->remote_config('local')]}) doesn't exist\n"
+ unless -d $self->remote_config("local");
+
+ my $change
+ = File::Spec->abs2rel( Cwd::cwd, $self->remote_config("local") );
+ die
+ "Current path isn't inside of local testing root (@{[$self->remote_config('local')]})\n"
+ if $change =~ /^\.\./;
+
+ die "Testing host not defined\n"
+ unless grep { defined and not /\.example\.com$/ }
+ @{ $self->remote_config("host") };
+
+ die
+ "Can't find or execute ssh command: @{[$self->remote_config('ssh')]}\n"
+ unless -e $self->remote_config("ssh")
+ and -x $self->remote_config("ssh");
+
$ENV{HARNESS_PERL} = $self->remote_config("ssh");
- $self->jobs( $self->jobs * @{$self->remote_config("host")});
+ $self->jobs( $self->jobs * @{ $self->remote_config("host") } );
- $self->callback(before_runtests => sub {$self->rsync(@_)});
- $self->callback(parser_args => sub {$self->change_switches(@_)});
+ $self->callback( before_runtests => sub { $self->rsync(@_) } );
+ $self->callback( parser_args => sub { $self->change_switches(@_) } );
return $self;
}
@@ -117,15 +136,15 @@
sub default_config {
return {
- user => "chimps",
- host => "smoke-int",
- root => "/home/chimps/remote-test/$ENV{USER}/",
- perl => "/home/chimps/bin/perl",
- local => "/home/$ENV{USER}/remote-test/",
- ssh => "/usr/bin/ssh",
- ssh_args => ["-x", "-S", "~/.ssh/master-%r@%h:%p"],
- master => 1,
- };
+ user => "smoker",
+ host => "smoke-server.example.com",
+ root => "/home/smoker/remote-test/$ENV{USER}/",
+ perl => "/home/smoker/bin/perl",
+ local => "/home/$ENV{USER}/remote-test/",
+ ssh => "/usr/bin/ssh",
+ ssh_args => [ "-x", "-S", "~/.ssh/master-%r@%h:%p" ],
+ master => 1,
+ };
}
=head2 load_remote_config
@@ -137,22 +156,25 @@
sub load_remote_config {
my $self = shift;
- unless (-e $self->config_path and -r $self->config_path) {
- YAML::DumpFile($self->config_path, $self->default_config);
+ unless ( -e $self->config_path and -r $self->config_path ) {
+ YAML::DumpFile( $self->config_path, $self->default_config );
}
- $self->{remote_config} = YAML::LoadFile($self->config_path);
+ $self->{remote_config} = YAML::LoadFile( $self->config_path );
# Make sure paths end with slashes, for rsync
- $self->{remote_config}{root} .= "/" unless $self->{remote_config}{root} =~ m|/$|;
- $self->{remote_config}{local} .= "/" unless $self->{remote_config}{local} =~ m|/$|;
+ $self->{remote_config}{root} .= "/"
+ unless $self->{remote_config}{root} =~ m|/$|;
+ $self->{remote_config}{local} .= "/"
+ unless $self->{remote_config}{local} =~ m|/$|;
# Host should be an arrayref
- $self->{remote_config}{host} = [$self->{remote_config}{host}]
- unless ref $self->{remote_config}{host};
+ $self->{remote_config}{host} = [ $self->{remote_config}{host} ]
+ unless ref $self->{remote_config}{host};
# Ditto ssh_args
- $self->{remote_config}{ssh_args} = [split ' ', $self->{remote_config}{ssh_args}]
- unless ref $self->{remote_config}{ssh_args};
+ $self->{remote_config}{ssh_args}
+ = [ split ' ', $self->{remote_config}{ssh_args} ]
+ unless ref $self->{remote_config}{ssh_args};
}
=head2 remote_config KEY
@@ -164,7 +186,7 @@
sub remote_config {
my $self = shift;
$self->load_remote_config unless $self->{remote_config};
- return $self->{remote_config}->{shift @_};
+ return $self->{remote_config}->{ shift @_ };
}
=head2 userhost [HOST]
@@ -178,7 +200,7 @@
my $self = shift;
my $userhost = @_ ? shift : $self->remote_config("host")->[0];
$userhost = $self->remote_config("user") . "\@" . $userhost
- if $self->remote_config("user");
+ if $self->remote_config("user");
return $userhost;
}
@@ -194,13 +216,13 @@
my $self = shift;
return unless $self->remote_config("master");
- for my $host (@{$self->remote_config("host")}) {
+ for my $host ( @{ $self->remote_config("host") } ) {
my $userhost = $self->userhost($host);
- my $pid = fork;
+ my $pid = fork;
die "Fork failed: $!" unless $pid >= 0;
- if (not $pid) {
- exec $self->remote_config("ssh"), @{$self->remote_config("ssh_args")},
- "-M", "-N", $userhost;
+ if ( not $pid ) {
+ exec $self->remote_config("ssh"),
+ @{ $self->remote_config("ssh_args") }, "-M", "-N", $userhost;
die "Starting of master SSH connection failed";
}
$self->{ssh_master}{$userhost} = $pid;
@@ -222,20 +244,24 @@
my $self = shift;
$self->start_masters;
- for my $host (@{$self->remote_config("host")}) {
+ for my $host ( @{ $self->remote_config("host") } ) {
my $userhost = $self->userhost($host);
- my $return = system(qw!rsync -avz --delete!,
- qq!--rsh!, $self->remote_config("ssh") . " @{$self->remote_config('ssh_args')}",
- $self->remote_config("local"),
- "$userhost:" . $self->remote_config("root"));
+ my $return = system(
+ qw!rsync -avz --delete!,
+ qq!--rsh!,
+ $self->remote_config("ssh")
+ . " @{$self->remote_config('ssh_args')}",
+ $self->remote_config("local"),
+ "$userhost:" . $self->remote_config("root")
+ );
die "rsync to $userhost failed" if $return;
}
- if (my $lib = $ENV{PERL5LIB}) {
- my @lib = split(/:/, $lib);
- my $local = $self->remote_config("local");
+ if ( my $lib = $ENV{PERL5LIB} ) {
+ my @lib = split( /:/, $lib );
+ my $local = $self->remote_config("local");
my $remote = $self->remote_config("root");
- $ENV{PERL5LIB} = join(":", map {s/^$local/$remote/; $_} @lib );
+ $ENV{PERL5LIB} = join( ":", map { s/^$local/$remote/; $_ } @lib );
}
}
@@ -248,9 +274,10 @@
sub DESTROY {
my $self = shift;
return unless $self->remote_config("master");
- for my $userhost (keys %{$self->{ssh_master} || {}}) {
+ for my $userhost ( keys %{ $self->{ssh_master} || {} } ) {
next unless kill 0, $self->{ssh_master}{$userhost};
- system "/usr/bin/ssh", @{$self->remote_config("ssh_args")}, "-O", "exit", $userhost;
+ system "/usr/bin/ssh", @{ $self->remote_config("ssh_args") }, "-O",
+ "exit", $userhost;
}
}
@@ -264,22 +291,27 @@
sub change_switches {
my ( $self, $args, $test ) = @_;
- my $local = $self->remote_config("local");
+ my $local = $self->remote_config("local");
my $remote = $self->remote_config("root");
- $ENV{PERL5LIB} ||='';
+ $ENV{PERL5LIB} ||= '';
$ENV{PERL5LIB} =~ s/^(lib:){1,}/lib:/;
- my @other = grep {not /^-I/} @{$args->{switches}};
- my @inc = map {s/^-I$local/-I$remote/; $_} grep {/^-I/} @{$args->{switches}};
-
- my $change = File::Spec->abs2rel(Cwd::cwd, $local);
- my $host = $self->remote_config("host")->[$self->{hostno}++ % @{$self->remote_config("host")}];
+ my @other = grep { not /^-I/ } @{ $args->{switches} };
+ my @inc = map { s/^-I$local/-I$remote/; $_ }
+ grep {/^-I/} @{ $args->{switches} };
+
+ my $change = File::Spec->abs2rel( Cwd::cwd, $local );
+ my $host = $self->remote_config("host")
+ ->[ $self->{hostno}++ % @{ $self->remote_config("host") } ];
my $userhost = $self->userhost($host);
- $args->{switches} = [@{$self->remote_config("ssh_args")}, $userhost,
- "cd", $remote.$change, "&&",
- "PERL5LIB='$ENV{PERL5LIB}'",
- $self->remote_config("perl"), @other, @inc];
+ $args->{switches} = [
+ @{ $self->remote_config("ssh_args") }, $userhost,
+ "cd", $remote . $change,
+ "&&", "PERL5LIB='$ENV{PERL5LIB}'",
+ $self->remote_config("perl"), @other,
+ @inc
+ ];
}
=head1 CONFIGURATION AND ENVIRONMENT
@@ -312,7 +344,7 @@
=item perl
-The C<perl> binary to run on the remote host
+The path to the C<perl> binary on the remote host.
=item ssh
@@ -351,7 +383,8 @@
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2007, Best Practical Solutions, LLC. All rights reserved.
+Copyright (c) 2007-2008, Best Practical Solutions, LLC. All rights
+reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
More information about the Bps-public-commit
mailing list