[Bps-public-commit] Test-Chimps-Client branch, master, updated. 3cffdb1702ead19c1f7760cf5eedf442672b3413
Ruslan Zakirov
ruz at bestpractical.com
Thu May 21 17:03:06 EDT 2009
The branch, master has been updated
via 3cffdb1702ead19c1f7760cf5eedf442672b3413 (commit)
via 0b9f986cf76b7b7027efa4317c44c4a042a159d1 (commit)
via 545a9be291804790650c319ac41970fcebc2b3c3 (commit)
via 8f4c97229b6575542ce0d071c3fb84844e2c6489 (commit)
via 8f7543879dff54e25f160d5cc346737e8ddd79b2 (commit)
via d7b8a2085fa8f2cce7a159c1c87784924545ed80 (commit)
via 5c96bde7d070c5d0998ead8fc3134428cccd591c (commit)
via 62afd094d7e1ce93ce6650cad0b004a302aaef49 (commit)
via d46ad5d3f78b143a0a757b5c6caa21e4d945ca95 (commit)
via 3dbd930af64626486f63ba0f0c0a3775d9d72219 (commit)
via 415b53961b65ff90cb1313509e83d8cd08229d65 (commit)
from 6a7a7cb7e1626c92eca868df4917363816c27a63 (commit)
Summary of changes:
lib/Test/Chimps/Smoker.pm | 605 ++++++++++++++++++++------------------
lib/Test/Chimps/Smoker/Git.pm | 55 ++++
lib/Test/Chimps/Smoker/SVN.pm | 65 ++++
lib/Test/Chimps/Smoker/Source.pm | 34 +++
4 files changed, 469 insertions(+), 290 deletions(-)
create mode 100644 lib/Test/Chimps/Smoker/Git.pm
create mode 100644 lib/Test/Chimps/Smoker/SVN.pm
create mode 100644 lib/Test/Chimps/Smoker/Source.pm
- Log -----------------------------------------------------------------
commit 415b53961b65ff90cb1313509e83d8cd08229d65
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Wed May 20 20:01:58 2009 +0400
* add CHIMPS_<PROJECT>_ROOT to the ENV
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index fff9fe0..7c689e8 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -347,8 +347,6 @@ sub _checkout_project {
system("svn", "co", "-r", $revision, $project->{svn_uri}, $tmpdir);
- $self->_push_onto_env_stack($project->{env});
-
my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
= File::Spec->catdir($tmpdir, $project->{root_dir});
@@ -356,6 +354,8 @@ sub _checkout_project {
'blib/lib', @{ $project->{libs} || [] };
$self->meta->{ $project->{'name'} }{'libs'} = [@libs];
+ $self->_push_onto_env_stack($project->{env}, 'CHIMPS_'. uc($project->{'name'}) .'_ROOT' => $projectdir);
+
my @otherlibs;
if (defined $project->{dependencies}) {
foreach my $dep (@{$project->{dependencies}}) {
commit 3dbd930af64626486f63ba0f0c0a3775d9d72219
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Thu May 21 15:29:53 2009 +0400
* tidy indent only
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 7c689e8..4c83ffa 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -66,52 +66,52 @@ file.
use base qw/Class::Accessor/;
__PACKAGE__->mk_ro_accessors(qw/server config_file simulate/);
__PACKAGE__->mk_accessors(
- qw/_env_stack meta config projects iterations/);
+ qw/_env_stack meta config projects iterations/);
# add a signal handler so destructor gets run
$SIG{INT} = sub {print "caught sigint. cleaning up...\n"; exit(1)};
$ENV{PERL5LIB} = "" unless defined $ENV{PERL5LIB}; # Warnings avoidance
sub new {
- my $class = shift;
- my $obj = bless {}, $class;
- $obj->_init(@_);
- return $obj;
+ my $class = shift;
+ my $obj = bless {}, $class;
+ $obj->_init(@_);
+ return $obj;
}
sub _init {
- my $self = shift;
- my %args = validate_with(
- params => \@_,
- spec => {
- server => 1,
- config_file => 1,
- simulate => 0,
- iterations => {
- optional => 1,
- default => 'inf'
- },
- projects => {
- optional => 1,
- default => 'all'
- },
- jobs => {
- optional => 1,
- type => SCALAR,
- regex => qr/^\d+$/,
- default => 1,
- },
- },
- called => 'The Test::Chimps::Smoker constructor'
- );
-
- foreach my $key (keys %args) {
- $self->{$key} = $args{$key};
- }
- $self->_env_stack([]);
- $self->meta({});
-
- $self->load_config;
+ my $self = shift;
+ my %args = validate_with(
+ params => \@_,
+ spec => {
+ server => 1,
+ config_file => 1,
+ simulate => 0,
+ iterations => {
+ optional => 1,
+ default => 'inf'
+ },
+ projects => {
+ optional => 1,
+ default => 'all'
+ },
+ jobs => {
+ optional => 1,
+ type => SCALAR,
+ regex => qr/^\d+$/,
+ default => 1,
+ },
+ },
+ called => 'The Test::Chimps::Smoker constructor'
+ );
+
+ foreach my $key (keys %args) {
+ $self->{$key} = $args{$key};
+ }
+ $self->_env_stack([]);
+ $self->meta({});
+
+ $self->load_config;
}
sub load_config {
@@ -136,95 +136,97 @@ sub DESTROY {
}
sub _smoke_once {
- my $self = shift;
- my $project = shift;
- my $config = $self->config;
-
- return 1 if $config->{$project}->{dependency_only};
-
- my $info_out = `svn info $config->{$project}->{svn_uri}`;
- $info_out =~ m/^Revision: (\d+)/m;
- my $latest_revision = $1;
- $info_out =~ m/^Last Changed Rev: (\d+)/m;
- my $last_changed_revision = $1;
-
- my $old_revision = $config->{$project}->{revision};
-
- return 0 unless $last_changed_revision > $old_revision;
-
- my @revisions = (($old_revision + 1) .. $latest_revision);
- my $revision;
- while (@revisions) {
- $revision = shift @revisions;
- # only actually do the check out if the revision and last changed revision match for
- # a particular revision
- last if _change_on_revision($config->{$project}->{svn_uri}, $revision);
- }
-
- $info_out = `svn info -r $revision $config->{$project}->{svn_uri}`;
- $info_out =~ m/^Last Changed Author: (\w+)/m;
- my $committer = $1;
-
- my @libs = $self->_checkout_project($config->{$project}, $revision);
- unless (@libs) {
- print "Skipping report report for $project revision $revision due to build failure\n";
- $self->update_revision( $project => $revision );
- return 0;
- }
- my @dbs = $self->_list_dbs;
-
- print "running tests for $project\n";
- my $test_glob = $config->{$project}->{test_glob} || 't/*.t t/*/t/*.t';
- my $tmpfile = File::Temp->new( SUFFIX => ".tar.gz" );
- my $harness = TAP::Harness::Archive->new( {
- archive => $tmpfile,
- extra_properties => {
- project => $project,
- revision => $revision,
- committer => $committer,
- osname => $Config{osname},
- osvers => $Config{osvers},
- archname => $Config{archname},
- },
- jobs => ($config->{$project}{jobs} || $self->{jobs}),
- lib => \@libs,
- } );
- {
- # Runtests apparently grows PERL5LIB -- local it so it doesn't
- # grow without bound
- local $ENV{PERL5LIB} = $ENV{PERL5LIB};
- $harness->runtests(glob($test_glob));
- }
-
- $self->_unroll_env_stack;
-
- chdir(File::Spec->rootdir);
-
- $self->remove_checkouts;
-
- $self->_clean_dbs(@dbs);
-
- my $client = Test::Chimps::Client->new(
- archive => $tmpfile,
- server => $self->server
- );
-
- my ($status, $msg);
- if ($self->simulate) {
- $status = 1;
- } else {
- print "Sending smoke report for @{[$self->server]}\n";
- ($status, $msg) = $client->send;
- }
-
- if ($status) {
- print "Sumbitted smoke report for $project revision $revision\n";
- $self->update_revision( $project => $revision );
- return 1;
- } else {
- print "Error: the server responded: $msg\n";
- return 0;
- }
+ my $self = shift;
+ my $project = shift;
+ my $config = $self->config;
+
+ return 1 if $config->{$project}->{dependency_only};
+
+ my $info_out = `svn info $config->{$project}->{svn_uri}`;
+ $info_out =~ m/^Revision: (\d+)/m;
+ my $latest_revision = $1;
+ $info_out =~ m/^Last Changed Rev: (\d+)/m;
+ my $last_changed_revision = $1;
+
+ my $old_revision = $config->{$project}->{revision};
+
+ return 0 unless $last_changed_revision > $old_revision;
+
+ my @revisions = (($old_revision + 1) .. $latest_revision);
+ my $revision;
+ while (@revisions) {
+ $revision = shift @revisions;
+
+# only actually do the check out if the revision and last changed revision match for
+# a particular revision
+ last if _change_on_revision($config->{$project}->{svn_uri}, $revision);
+ }
+
+ $info_out = `svn info -r $revision $config->{$project}->{svn_uri}`;
+ $info_out =~ m/^Last Changed Author: (\w+)/m;
+ my $committer = $1;
+
+ my @libs = $self->_checkout_project($config->{$project}, $revision);
+ unless (@libs) {
+ print "Skipping report report for $project revision $revision due to build failure\n";
+ $self->update_revision( $project => $revision );
+ return 0;
+ }
+ my @dbs = $self->_list_dbs;
+
+ print "running tests for $project\n";
+ my $test_glob = $config->{$project}->{test_glob} || 't/*.t t/*/t/*.t';
+ my $tmpfile = File::Temp->new( SUFFIX => ".tar.gz" );
+ my $harness = TAP::Harness::Archive->new( {
+ archive => $tmpfile,
+ extra_properties => {
+ project => $project,
+ revision => $revision,
+ committer => $committer,
+ osname => $Config{osname},
+ osvers => $Config{osvers},
+ archname => $Config{archname},
+ },
+ jobs => ($config->{$project}{jobs} || $self->{jobs}),
+ lib => \@libs,
+ } );
+ {
+
+ # Runtests apparently grows PERL5LIB -- local it so it doesn't
+ # grow without bound
+ local $ENV{PERL5LIB} = $ENV{PERL5LIB};
+ $harness->runtests(glob($test_glob));
+ }
+
+ $self->_unroll_env_stack;
+
+ chdir(File::Spec->rootdir);
+
+ $self->remove_checkouts;
+
+ $self->_clean_dbs(@dbs);
+
+ my $client = Test::Chimps::Client->new(
+ archive => $tmpfile,
+ server => $self->server
+ );
+
+ my ($status, $msg);
+ if ($self->simulate) {
+ $status = 1;
+ } else {
+ print "Sending smoke report for @{[$self->server]}\n";
+ ($status, $msg) = $client->send;
+ }
+
+ if ($status) {
+ print "Sumbitted smoke report for $project revision $revision\n";
+ $self->update_revision( $project => $revision );
+ return 1;
+ } else {
+ print "Error: the server responded: $msg\n";
+ return 0;
+ }
}
sub remove_checkouts {
@@ -238,32 +240,32 @@ sub remove_checkouts {
}
sub _smoke_n_times {
- my $self = shift;
- my $n = shift;
- my $projects = shift;
-
- if ($n <= 0) {
- die "Can not smoke projects a negative number of times";
- } elsif ($n eq 'inf') {
- while (1) {
- $self->_smoke_projects($projects);
- sleep 60;
- }
- } else {
- for (my $i = 0; $i < $n;) {
- $i++ if $self->_smoke_projects($projects);
- sleep 60;
+ my $self = shift;
+ my $n = shift;
+ my $projects = shift;
+
+ if ($n <= 0) {
+ die "Can not smoke projects a negative number of times";
+ } elsif ($n eq 'inf') {
+ while (1) {
+ $self->_smoke_projects($projects);
+ sleep 60;
+ }
+ } else {
+ for (my $i = 0; $i < $n;) {
+ $i++ if $self->_smoke_projects($projects);
+ sleep 60;
+ }
}
- }
}
sub _smoke_projects {
- my $self = shift;
- my $projects = shift;
+ my $self = shift;
+ my $projects = shift;
- foreach my $project (@$projects) {
- $self->_smoke_once($project);
- }
+ foreach my $project (@$projects) {
+ $self->_smoke_once($project);
+ }
}
=head2 smoke PARAMS
@@ -294,181 +296,182 @@ projects will be smoked. Defaults to 'all'.
=cut
sub smoke {
- my $self = shift;
- my $config = $self->config;
-
- my %args = validate_with(
- params => \@_,
- spec => {
- iterations => {
- optional => 1,
- type => SCALAR,
- regex => qr/^(inf|\d+)$/,
- default => 'inf'
- },
- projects => {
- optional => 1,
- type => ARRAYREF | SCALAR,
- default => 'all'
- }
- },
- called => 'Test::Chimps::Smoker->smoke'
- );
-
- my $projects = $args{projects};
- my $iterations = $args{iterations};
- $self->_validate_projects_opt($projects);
-
- if ($projects eq 'all') {
- $projects = [keys %$config];
- }
-
- $self->_smoke_n_times($iterations, $projects);
+ my $self = shift;
+ my $config = $self->config;
+
+ my %args = validate_with(
+ params => \@_,
+ spec => {
+ iterations => {
+ optional => 1,
+ type => SCALAR,
+ regex => qr/^(inf|\d+)$/,
+ default => 'inf'
+ },
+ projects => {
+ optional => 1,
+ type => ARRAYREF | SCALAR,
+ default => 'all'
+ }
+ },
+ called => 'Test::Chimps::Smoker->smoke'
+ );
+
+ my $projects = $args{projects};
+ my $iterations = $args{iterations};
+ $self->_validate_projects_opt($projects);
+
+ if ($projects eq 'all') {
+ $projects = [keys %$config];
+ }
+
+ $self->_smoke_n_times($iterations, $projects);
}
sub _validate_projects_opt {
- my ($self, $projects) = @_;
- return if $projects eq 'all';
+ my ($self, $projects) = @_;
+ return if $projects eq 'all';
- foreach my $project (@$projects) {
- die "no such project: '$project'"
- unless exists $self->config->{$project};
- }
+ foreach my $project (@$projects) {
+ die "no such project: '$project'"
+ unless exists $self->config->{$project};
+ }
}
sub _checkout_project {
- my $self = shift;
- my $project = shift;
- my $revision = shift;
-
- my $tmpdir = tempdir("chimps-svn-XXXXXXX", TMPDIR => 1);
- $self->meta->{ $project->{'name'} }{'checkout'} = $tmpdir;
-
- system("svn", "co", "-r", $revision, $project->{svn_uri}, $tmpdir);
-
- my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
- = File::Spec->catdir($tmpdir, $project->{root_dir});
-
- my @libs = map File::Spec->catdir($projectdir, $_),
- 'blib/lib', @{ $project->{libs} || [] };
- $self->meta->{ $project->{'name'} }{'libs'} = [@libs];
-
- $self->_push_onto_env_stack($project->{env}, 'CHIMPS_'. uc($project->{'name'}) .'_ROOT' => $projectdir);
-
- my @otherlibs;
- if (defined $project->{dependencies}) {
- foreach my $dep (@{$project->{dependencies}}) {
- if ( $self->meta->{ $dep }{'checkout'} ) {
- push @otherlibs, @{ $self->meta->{ $dep }{'libs'} };
- next;
- }
-
- print "processing dependency $dep\n";
- my @deplibs = $self->_checkout_project($self->config->{$dep}, 'HEAD');
- if (@deplibs) {
- push @otherlibs, @deplibs;
- } else {
- print "Dependency $dep failed; aborting";
- return ();
- }
+ my $self = shift;
+ my $project = shift;
+ my $revision = shift;
+
+ my $tmpdir = tempdir("chimps-svn-XXXXXXX", TMPDIR => 1);
+ $self->meta->{ $project->{'name'} }{'checkout'} = $tmpdir;
+
+ system("svn", "co", "-r", $revision, $project->{svn_uri}, $tmpdir);
+
+ my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
+ = File::Spec->catdir($tmpdir, $project->{root_dir});
+
+ my @libs = map File::Spec->catdir($projectdir, $_),
+ 'blib/lib', @{ $project->{libs} || [] };
+ $self->meta->{ $project->{'name'} }{'libs'} = [@libs];
+
+ $self->_push_onto_env_stack($project->{env}, 'CHIMPS_'. uc($project->{'name'}) .'_ROOT' => $projectdir);
+
+ my @otherlibs;
+ if (defined $project->{dependencies}) {
+ foreach my $dep (@{$project->{dependencies}}) {
+ if ( $self->meta->{ $dep }{'checkout'} ) {
+ push @otherlibs, @{ $self->meta->{ $dep }{'libs'} };
+ next;
+ }
+
+ print "processing dependency $dep\n";
+ my @deplibs = $self->_checkout_project($self->config->{$dep}, 'HEAD');
+ if (@deplibs) {
+ push @otherlibs, @deplibs;
+ } else {
+ print "Dependency $dep failed; aborting";
+ return ();
+ }
+ }
}
- }
- my %seen;
- @libs = grep {not $seen{$_}++} @libs, @otherlibs;
+ my %seen;
+ @libs = grep {not $seen{$_}++} @libs, @otherlibs;
- unless (chdir($projectdir)) {
- print "chdir to $projectdir failed -- check value of root_dir?\n";
- return ();
- }
+ unless (chdir($projectdir)) {
+ print "chdir to $projectdir failed -- check value of root_dir?\n";
+ return ();
+ }
- local $ENV{PERL5LIB} = join(":", at libs,$ENV{PERL5LIB});
+ local $ENV{PERL5LIB} = join(":", at libs,$ENV{PERL5LIB});
- if (defined $project->{configure_cmd}) {
- my $ret = system($project->{configure_cmd});
- if ($ret) {
- print "Return value of @{[$project->{configure_cmd}]} from $projectdir = $ret\n"
- if $ret;
- return ();
- }
- }
+ if (defined $project->{configure_cmd}) {
+ my $ret = system($project->{configure_cmd});
+ if ($ret) {
+ print "Return value of @{[$project->{configure_cmd}]} from $projectdir = $ret\n"
+ if $ret;
+ return ();
+ }
+ }
- return @libs;
+ return @libs;
}
sub _list_dbs {
local $ENV{DBI_USER} = "postgres";
return map {s/.*dbname=(.*)/$1/ ? $_ : () }
- DBI->data_sources("Pg");
+ DBI->data_sources("Pg");
}
sub _clean_dbs {
my %skip = map {($_ => 1)} @_;
local $ENV{DBI_USER} = "postgres";
- my @dbs = grep {not $skip{$_}}
- _list_dbs();
+ my @dbs = grep {not $skip{$_}}
+ _list_dbs();
my $dbh = DBI->connect("dbi:Pg:dbname=template1","postgres","",{RaiseError => 1});
$dbh->do("DROP DATABASE $_") for @dbs;
}
sub _remove_tmpdir {
- my $tmpdir = shift;
- print "removing temporary directory $tmpdir\n";
- rmtree($tmpdir, 0, 0);
+ my $tmpdir = shift;
+ print "removing temporary directory $tmpdir\n";
+ rmtree($tmpdir, 0, 0);
}
sub _change_on_revision {
- my $uri = shift;
- my $revision = shift;
+ my $uri = shift;
+ my $revision = shift;
- my $info_out = `svn info -r $revision $uri`;
- $info_out =~ m/^Revision: (\d+)/m;
- my $latest_revision = $1;
- $info_out =~ m/^Last Changed Rev: (\d+)/m;
- my $last_changed_revision = $1;
+ my $info_out = `svn info -r $revision $uri`;
+ $info_out =~ m/^Revision: (\d+)/m;
+ my $latest_revision = $1;
+ $info_out =~ m/^Last Changed Rev: (\d+)/m;
+ my $last_changed_revision = $1;
- return $latest_revision == $last_changed_revision;
+ return $latest_revision == $last_changed_revision;
}
sub _push_onto_env_stack {
- my $self = shift;
- my $vars = shift;
-
- my $frame = {};
- foreach my $var (keys %$vars) {
- if (exists $ENV{$var}) {
- $frame->{$var} = $ENV{$var};
- } else {
- $frame->{$var} = undef;
+ my $self = shift;
+ my $vars = shift;
+
+ my $frame = {};
+ foreach my $var (keys %$vars) {
+ if (exists $ENV{$var}) {
+ $frame->{$var} = $ENV{$var};
+ } else {
+ $frame->{$var} = undef;
+ }
+ my $value = $vars->{$var};
+
+ # old value substitution
+ $value =~ s/\$$var/$ENV{$var}/g;
+
+ print "setting environment variable $var to $value\n";
+ $ENV{$var} = $value;
}
- my $value = $vars->{$var};
- # old value substitution
- $value =~ s/\$$var/$ENV{$var}/g;
-
- print "setting environment variable $var to $value\n";
- $ENV{$var} = $value;
- }
- push @{$self->_env_stack}, $frame;
+ push @{$self->_env_stack}, $frame;
}
sub _unroll_env_stack {
- my $self = shift;
-
- while (scalar @{$self->_env_stack}) {
- my $frame = pop @{$self->_env_stack};
- foreach my $var (keys %$frame) {
- if (defined $frame->{$var}) {
- print "reverting environment variable $var to $frame->{$var}\n";
- $ENV{$var} = $frame->{$var};
- } else {
- print "unsetting environment variable $var\n";
- delete $ENV{$var};
- }
+ my $self = shift;
+
+ while (scalar @{$self->_env_stack}) {
+ my $frame = pop @{$self->_env_stack};
+ foreach my $var (keys %$frame) {
+ if (defined $frame->{$var}) {
+ print "reverting environment variable $var to $frame->{$var}\n";
+ $ENV{$var} = $frame->{$var};
+ } else {
+ print "unsetting environment variable $var\n";
+ delete $ENV{$var};
+ }
+ }
}
- }
}
=head1 ACCESSORS
commit d46ad5d3f78b143a0a757b5c6caa21e4d945ca95
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Thu May 21 22:22:43 2009 +0400
* factor out Smoker/SVN.pm
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 4c83ffa..4d56705 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -8,6 +8,7 @@ use File::Basename;
use File::Path;
use File::Temp qw/tempdir/;
use Params::Validate qw/:all/;
+use Test::Chimps::Smoker::Source;
use Test::Chimps::Client;
use TAP::Harness::Archive;
use YAML::Syck;
@@ -118,10 +119,25 @@ sub load_config {
my $self = shift;
my $cfg = $self->config(LoadFile($self->config_file));
+
+ # update old style config file
+ {
+ my $found_old_style = 0;
+ foreach ( grep $_->{svn_uri}, values %$cfg ) {
+ $found_old_style = 1;
+
+ $_->{'repository'} = {
+ type => 'SVN',
+ uri => delete $_->{svn_uri},
+ };
+ }
+ DumpFile($self->config_file, $cfg) if $found_old_style;
+ }
+
$cfg->{$_}->{'name'} = $_ foreach keys %$cfg;
}
-sub update_revision {
+sub update_revision_in_config {
my $self = shift;
my ($project, $revision) = @_;
@@ -135,59 +151,50 @@ sub DESTROY {
$self->remove_checkouts;
}
-sub _smoke_once {
+sub source {
my $self = shift;
my $project = shift;
- my $config = $self->config;
-
- return 1 if $config->{$project}->{dependency_only};
-
- my $info_out = `svn info $config->{$project}->{svn_uri}`;
- $info_out =~ m/^Revision: (\d+)/m;
- my $latest_revision = $1;
- $info_out =~ m/^Last Changed Rev: (\d+)/m;
- my $last_changed_revision = $1;
-
- my $old_revision = $config->{$project}->{revision};
+ $self->meta->{$project}{'source'} ||= Test::Chimps::Smoker::Source->new(
+ %{ $self->config->{$project}{'repository'} },
+ config => $self->config->{$project},
+ );
+ return $self->meta->{$project}{'source'};
+}
- return 0 unless $last_changed_revision > $old_revision;
+sub _smoke_once {
+ my $self = shift;
+ my $project = shift;
- my @revisions = (($old_revision + 1) .. $latest_revision);
- my $revision;
- while (@revisions) {
- $revision = shift @revisions;
+ my $config = $self->config->{$project};
+ return 1 if $config->{dependency_only};
-# only actually do the check out if the revision and last changed revision match for
-# a particular revision
- last if _change_on_revision($config->{$project}->{svn_uri}, $revision);
- }
+ my %next = $self->source($project)->next( $config->{revision} );
+ return 0 unless keys %next;
- $info_out = `svn info -r $revision $config->{$project}->{svn_uri}`;
- $info_out =~ m/^Last Changed Author: (\w+)/m;
- my $committer = $1;
+ my $revision = $next{'revision'};
- my @libs = $self->_checkout_project($config->{$project}, $revision);
+ my @libs = $self->_checkout_project($config, $revision);
unless (@libs) {
print "Skipping report report for $project revision $revision due to build failure\n";
- $self->update_revision( $project => $revision );
+ $self->update_revision_in_config( $project => $revision );
return 0;
}
my @dbs = $self->_list_dbs;
print "running tests for $project\n";
- my $test_glob = $config->{$project}->{test_glob} || 't/*.t t/*/t/*.t';
+ my $test_glob = $config->{test_glob} || 't/*.t t/*/t/*.t';
my $tmpfile = File::Temp->new( SUFFIX => ".tar.gz" );
my $harness = TAP::Harness::Archive->new( {
archive => $tmpfile,
extra_properties => {
project => $project,
revision => $revision,
- committer => $committer,
+ committer => $next{'committer'},
osname => $Config{osname},
osvers => $Config{osvers},
archname => $Config{archname},
},
- jobs => ($config->{$project}{jobs} || $self->{jobs}),
+ jobs => ($config->{jobs} || $self->{jobs}),
lib => \@libs,
} );
{
@@ -221,7 +228,7 @@ sub _smoke_once {
if ($status) {
print "Sumbitted smoke report for $project revision $revision\n";
- $self->update_revision( $project => $revision );
+ $self->update_revision_in_config( $project => $revision );
return 1;
} else {
print "Error: the server responded: $msg\n";
@@ -347,7 +354,9 @@ sub _checkout_project {
my $tmpdir = tempdir("chimps-svn-XXXXXXX", TMPDIR => 1);
$self->meta->{ $project->{'name'} }{'checkout'} = $tmpdir;
- system("svn", "co", "-r", $revision, $project->{svn_uri}, $tmpdir);
+ my $source = $self->source( $project->{'name'} )->checkout(
+ revision => $revision, directory => $tmpdir
+ );
my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
= File::Spec->catdir($tmpdir, $project->{root_dir});
@@ -422,19 +431,6 @@ sub _remove_tmpdir {
rmtree($tmpdir, 0, 0);
}
-sub _change_on_revision {
- my $uri = shift;
- my $revision = shift;
-
- my $info_out = `svn info -r $revision $uri`;
- $info_out =~ m/^Revision: (\d+)/m;
- my $latest_revision = $1;
- $info_out =~ m/^Last Changed Rev: (\d+)/m;
- my $last_changed_revision = $1;
-
- return $latest_revision == $last_changed_revision;
-}
-
sub _push_onto_env_stack {
my $self = shift;
my $vars = shift;
@@ -494,7 +490,9 @@ look like this:
- Jifty
revision: 555
root_dir: trunk/foo
- svn_uri: svn+ssh://svn.example.com/svn/foo
+ repository:
+ type: svn
+ uri: svn+ssh://svn.example.com/svn/foo
test_glob: t/*.t t/*/*.t
Jifty:
configure_cmd: perl Makefile.PL --skipdeps && make
@@ -502,7 +500,9 @@ look like this:
- Jifty-DBI
revision: 1332
root_dir: trunk
- svn_uri: svn+ssh://svn.jifty.org/svn/jifty.org/jifty
+ repository:
+ type: svn
+ uri: svn+ssh://svn.jifty.org/svn/jifty.org/jifty
Jifty-DBI:
configure_cmd: perl Makefile.PL --skipdeps && make
env:
@@ -513,7 +513,9 @@ look like this:
JDBI_TEST_PG_USER: jiftydbitest
revision: 1358
root_dir: trunk
- svn_uri: svn+ssh://svn.jifty.org/svn/jifty.org/Jifty-DBI
+ repository:
+ type: svn
+ uri: svn+ssh://svn.jifty.org/svn/jifty.org/Jifty-DBI
The supported project options are as follows:
diff --git a/lib/Test/Chimps/Smoker/SVN.pm b/lib/Test/Chimps/Smoker/SVN.pm
new file mode 100644
index 0000000..1d872bf
--- /dev/null
+++ b/lib/Test/Chimps/Smoker/SVN.pm
@@ -0,0 +1,66 @@
+package Test::Chimps::Smoker::SVN;
+
+use strict;
+use warnings;
+use base qw(Test::Chimps::Smoker::Source);
+__PACKAGE__->mk_ro_accessors(qw/uri/);
+
+sub revision_info {
+ my $self = shift;
+ my $revision = shift;
+
+ my $cmd = 'svn info'. ($revision? " -r $revision" : '') .' '. $self->uri;
+
+ my $info_out = `$cmd`;
+ my ($latest_revision) = ($info_out =~ m/^Revision: (\d+)/m);
+ my ($last_changed) = ($info_out =~ m/^Last Changed Rev: (\d+)/m);
+ my ($committer) = ($info_out =~ m/^Last Changed Author: (\w+)/m);
+
+ return ($latest_revision, $last_changed, $committer);
+}
+
+sub committer {
+ my $self = shift;
+ return ($self->revision_info( @_ ))[2];
+}
+
+sub is_change_on_revision {
+ my $self = shift;
+ my ($latest_revision, $last_changed) = $self->revision_info(@_);
+ return $latest_revision == $last_changed;
+}
+
+sub checkout {
+ my $self = shift;
+ my %args = @_;
+
+
+ system("svn", "co", "-r", $args{'revision'}, $self->uri, $args{'directory'});
+}
+
+sub next {
+ my $self = shift;
+ my ($latest_revision, $last_changed_revision) = $self->revision_info;
+
+ my $old_revision = $self->config->{revision};
+
+ return () unless $last_changed_revision > $old_revision;
+
+ my @revisions = (($old_revision + 1) .. $latest_revision);
+ my $revision;
+ while (@revisions) {
+ $revision = shift @revisions;
+
+# only actually do the check out if the revision and last changed revision match for
+# a particular revision
+ last if $self->is_change_on_revision($revision);
+ }
+ return () unless $revision;
+
+ my $committer = $self->committer($revision);
+
+
+ return (revision => $revision, committer => $committer);
+}
+
+1;
diff --git a/lib/Test/Chimps/Smoker/Source.pm b/lib/Test/Chimps/Smoker/Source.pm
new file mode 100644
index 0000000..ae4ee77
--- /dev/null
+++ b/lib/Test/Chimps/Smoker/Source.pm
@@ -0,0 +1,25 @@
+package Test::Chimps::Smoker::Source;
+
+use strict;
+use warnings;
+use base qw/Class::Accessor/;
+
+__PACKAGE__->mk_ro_accessors(qw/config/);
+
+sub new {
+ my $proto = shift;
+ my %args = @_;
+ my $type = delete $args{'type'} or die "No type of a source repository";
+
+ my $class = ref($proto) || $proto;
+ $class =~ s/[^:]*$/$type/;
+
+ eval "require $class; 1" or die "Couldn't load $class: $@";
+
+ my $obj = bless { %args }, $class;
+ return $obj->_init;
+}
+
+sub _init { return $_[0] }
+
+1;
commit 62afd094d7e1ce93ce6650cad0b004a302aaef49
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Thu May 21 22:23:27 2009 +0400
* first implementation of git sources
diff --git a/lib/Test/Chimps/Smoker/Git.pm b/lib/Test/Chimps/Smoker/Git.pm
new file mode 100644
index 0000000..bf0ac71
--- /dev/null
+++ b/lib/Test/Chimps/Smoker/Git.pm
@@ -0,0 +1,49 @@
+package Test::Chimps::Smoker::Git;
+
+use strict;
+use warnings;
+use base qw(Test::Chimps::Smoker::Source);
+__PACKAGE__->mk_ro_accessors(qw/uri/);
+
+sub revision_after {
+ my $self = shift;
+ my $revision = shift;
+
+ my $cmd = "git log --reverse $revision..origin";
+ my ($next) = (`$cmd` =~ m/^commit\s+([a-f0-9])/im);
+
+ return $next;
+}
+
+sub committer {
+ my $self = shift;
+ my $revision = shift;
+
+ my $cmd = 'git log -n1'. ($revision? " $revision" : '');
+ my ($committer) = (`$cmd` =~ m/^author:\s*(.*)$/im);
+
+ return $committer;
+}
+
+sub checkout {
+ my $self = shift;
+ my %args = @_;
+
+ system( qw(git clone), $self->uri, $args{'directory'} )
+ or die "couldn't clone ". $self->uri .": $!";
+ chdir $args{'directory'};
+ system qw(git checkout), $args{'revision'};
+}
+
+sub next {
+ my $self = shift;
+
+ my $revision = $self->revision_after( $self->config->{revision} );
+ return () unless $revision;
+
+ my $committer = $self->committer($revision);
+
+ return (revision => $revision, committer => $committer);
+}
+
+1;
commit 5c96bde7d070c5d0998ead8fc3134428cccd591c
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:50:10 2009 +0400
* cloned and directory accessors in the base Source class
diff --git a/lib/Test/Chimps/Smoker/Source.pm b/lib/Test/Chimps/Smoker/Source.pm
index ae4ee77..1f73d19 100644
--- a/lib/Test/Chimps/Smoker/Source.pm
+++ b/lib/Test/Chimps/Smoker/Source.pm
@@ -4,7 +4,8 @@ use strict;
use warnings;
use base qw/Class::Accessor/;
-__PACKAGE__->mk_ro_accessors(qw/config/);
+__PACKAGE__->mk_ro_accessors(qw/config smoker/);
+__PACKAGE__->mk_accessors(qw/directory cloned/);
sub new {
my $proto = shift;
@@ -22,4 +23,10 @@ sub new {
sub _init { return $_[0] }
+sub clone { return 1 }
+sub checkout { return 1 }
+sub clean { return 1 }
+
+sub next { return () }
+
1;
commit d7b8a2085fa8f2cce7a159c1c87784924545ed80
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:50:52 2009 +0400
* use directory method instead of argument
diff --git a/lib/Test/Chimps/Smoker/SVN.pm b/lib/Test/Chimps/Smoker/SVN.pm
index 1d872bf..e3d6db6 100644
--- a/lib/Test/Chimps/Smoker/SVN.pm
+++ b/lib/Test/Chimps/Smoker/SVN.pm
@@ -34,8 +34,7 @@ sub checkout {
my $self = shift;
my %args = @_;
-
- system("svn", "co", "-r", $args{'revision'}, $self->uri, $args{'directory'});
+ system("svn", "co", "-r", $args{'revision'}, $self->uri, $self->directory);
}
sub next {
commit 8f7543879dff54e25f160d5cc346737e8ddd79b2
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:51:43 2009 +0400
* we don't pass HEAD anymore, it's up to source driver
diff --git a/lib/Test/Chimps/Smoker/SVN.pm b/lib/Test/Chimps/Smoker/SVN.pm
index e3d6db6..4121eb5 100644
--- a/lib/Test/Chimps/Smoker/SVN.pm
+++ b/lib/Test/Chimps/Smoker/SVN.pm
@@ -34,7 +34,7 @@ sub checkout {
my $self = shift;
my %args = @_;
- system("svn", "co", "-r", $args{'revision'}, $self->uri, $self->directory);
+ system("svn", "co", "-r", ($args{'revision'} || 'HEAD'), $self->uri, $self->directory);
}
sub next {
commit 8f4c97229b6575542ce0d071c3fb84844e2c6489
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:52:23 2009 +0400
* split checkout into checkout+clone in Git driver
diff --git a/lib/Test/Chimps/Smoker/Git.pm b/lib/Test/Chimps/Smoker/Git.pm
index bf0ac71..2b29b64 100644
--- a/lib/Test/Chimps/Smoker/Git.pm
+++ b/lib/Test/Chimps/Smoker/Git.pm
@@ -25,13 +25,19 @@ sub committer {
return $committer;
}
+sub clone {
+ my $self = shift;
+
+ system( qw(git clone), $self->uri, $self->directory ) == 0
+ or die "couldn't clone ". $self->uri .": $!";
+
+ return 1;
+}
+
sub checkout {
my $self = shift;
my %args = @_;
- system( qw(git clone), $self->uri, $args{'directory'} )
- or die "couldn't clone ". $self->uri .": $!";
- chdir $args{'directory'};
system qw(git checkout), $args{'revision'};
}
commit 545a9be291804790650c319ac41970fcebc2b3c3
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:55:37 2009 +0400
* pass smoker into source and don't forget weaken it there
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 4d56705..1c3e31c 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -157,6 +157,7 @@ sub source {
$self->meta->{$project}{'source'} ||= Test::Chimps::Smoker::Source->new(
%{ $self->config->{$project}{'repository'} },
config => $self->config->{$project},
+ smoker => $self,
);
return $self->meta->{$project}{'source'};
}
diff --git a/lib/Test/Chimps/Smoker/Source.pm b/lib/Test/Chimps/Smoker/Source.pm
index 1f73d19..dcc45f4 100644
--- a/lib/Test/Chimps/Smoker/Source.pm
+++ b/lib/Test/Chimps/Smoker/Source.pm
@@ -3,6 +3,7 @@ package Test::Chimps::Smoker::Source;
use strict;
use warnings;
use base qw/Class::Accessor/;
+use Scalar::Util qw(weaken);
__PACKAGE__->mk_ro_accessors(qw/config smoker/);
__PACKAGE__->mk_accessors(qw/directory cloned/);
@@ -18,6 +19,7 @@ sub new {
eval "require $class; 1" or die "Couldn't load $class: $@";
my $obj = bless { %args }, $class;
+ weaken $obj->{'smoker'};
return $obj->_init;
}
commit 0b9f986cf76b7b7027efa4317c44c4a042a159d1
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:58:05 2009 +0400
* use ->directory source's accessor to store where we checkout project
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 1c3e31c..5c81af6 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -241,10 +241,12 @@ sub remove_checkouts {
my $self = shift;
my $meta = $self->meta;
- foreach my $tmpdir (grep length && defined, map $_->{'checkout'}, values %$meta ) {
- _remove_tmpdir($tmpdir);
+ foreach my $source ( grep $_, map $_->{'source'}, values %$meta ) {
+ next unless my $dir = $source->directory;
+
+ _remove_tmpdir($dir);
+ $source->directory(undef);
}
- delete @{$_}{'checkout'} foreach values %$meta;
}
sub _smoke_n_times {
@@ -334,7 +336,6 @@ sub smoke {
}
$self->_smoke_n_times($iterations, $projects);
-
}
sub _validate_projects_opt {
@@ -352,15 +353,12 @@ sub _checkout_project {
my $project = shift;
my $revision = shift;
- my $tmpdir = tempdir("chimps-svn-XXXXXXX", TMPDIR => 1);
- $self->meta->{ $project->{'name'} }{'checkout'} = $tmpdir;
-
- my $source = $self->source( $project->{'name'} )->checkout(
- revision => $revision, directory => $tmpdir
- );
+ my $source = $self->source( $project->{'name'} );
+ $source->checkout( revision => $revision );
+ my $tmpdir = $source->directory;
my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
- = File::Spec->catdir($tmpdir, $project->{root_dir});
+ = File::Spec->catdir($tmpdir, $project->{root_dir});
my @libs = map File::Spec->catdir($projectdir, $_),
'blib/lib', @{ $project->{libs} || [] };
commit 3cffdb1702ead19c1f7760cf5eedf442672b3413
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date: Fri May 22 00:59:32 2009 +0400
* add _clone_project method
Some tooles like Git can not talk to remote server to get info,
so we ->clone once, then we call ->checkout, ->___smoke, ->clean,
<-loop. Something like that
diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 5c81af6..9c3303d 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -169,6 +169,8 @@ sub _smoke_once {
my $config = $self->config->{$project};
return 1 if $config->{dependency_only};
+ $self->_clone_project( $config );
+
my %next = $self->source($project)->next( $config->{revision} );
return 0 unless keys %next;
@@ -348,6 +350,23 @@ sub _validate_projects_opt {
}
}
+sub _clone_project {
+ my $self = shift;
+ my $project = shift;
+
+ my $source = $self->source( $project->{'name'} );
+ return 1 if $source->cloned;
+
+ my $tmpdir = tempdir("chimps-XXXXXXX", TMPDIR => 1);
+ $source->directory( $tmpdir );
+ $source->clone;
+ chdir $tmpdir;
+
+ $source->cloned(1);
+
+ return 1;
+}
+
sub _checkout_project {
my $self = shift;
my $project = shift;
@@ -369,13 +388,15 @@ sub _checkout_project {
my @otherlibs;
if (defined $project->{dependencies}) {
foreach my $dep (@{$project->{dependencies}}) {
- if ( $self->meta->{ $dep }{'checkout'} ) {
+ if ( $self->source( $dep )->cloned ) {
push @otherlibs, @{ $self->meta->{ $dep }{'libs'} };
next;
}
print "processing dependency $dep\n";
- my @deplibs = $self->_checkout_project($self->config->{$dep}, 'HEAD');
+ my $config = $self->config->{ $dep };
+ $self->_clone_project( $config );
+ my @deplibs = $self->_checkout_project( $config );
if (@deplibs) {
push @otherlibs, @deplibs;
} else {
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list