[Bps-public-commit] smokingit-worker branch, master, created. 0dc3325bea32cfad42c9088e47a01c3d2a6bb5ea
Alex Vandiver
alexmv at bestpractical.com
Wed Jan 26 04:00:41 EST 2011
The branch, master has been created
at 0dc3325bea32cfad42c9088e47a01c3d2a6bb5ea (commit)
- Log -----------------------------------------------------------------
commit 2b32f460100b793095762b3e9de83e427cb68f31
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Sun Jan 23 22:17:59 2011 -0500
Initial import
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c05e777
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+repos
diff --git a/bin/smokingit-worker b/bin/smokingit-worker
new file mode 100755
index 0000000..2f551c0
--- /dev/null
+++ b/bin/smokingit-worker
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use lib 'lib';
+use Smokingit::Worker;
+
+my $worker = Smokingit::Worker->new(
+ repo_path => "repos",
+ job_servers => ['127.0.0.1:4730'],
+);
+$worker->run;
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
new file mode 100644
index 0000000..de2130a
--- /dev/null
+++ b/lib/Smokingit/Worker.pm
@@ -0,0 +1,170 @@
+use strict;
+use warnings;
+
+package Smokingit::Worker;
+use base 'Gearman::Worker';
+
+use TAP::Harness;
+
+use Gearman::Client;
+use Storable qw( freeze thaw );
+use YAML;
+
+use Smokingit::Worker::Clean::TmpFiles;
+use Smokingit::Worker::Clean::Postgres;
+
+use fields qw(max_jobs repo_path client);
+
+sub new {
+ my $class = shift;
+ my %args = (
+ max_jobs => 5,
+ @_,
+ );
+ my $self = $class->SUPER::new(%args);
+ $self->{max_jobs} = $args{max_jobs};
+ $self->{repo_path} = $args{repo_path};
+ die "No valid repository path set!"
+ unless $args{repo_path} and -d $args{repo_path};
+
+ return $self;
+}
+
+sub repo_path {
+ my $self = shift;
+ return $self->{repo_path} unless @_;
+ $self->{repo_path} = shift;
+}
+
+sub max_jobs {
+ my $self = shift;
+ return $self->{max_jobs} unless @_;
+ $self->{max_jobs} = shift || 1;
+}
+
+sub client {
+ my $self = shift;
+ return $self->{client};
+}
+
+sub run {
+ my $self = shift;
+ chdir($self->repo_path);
+ $self->register_function( run_tests => sub {$self->run_tests(@_)} );
+ $self->{client} = Gearman::Client->new(
+ job_servers => $self->job_servers,
+ );
+ $self->work while 1;
+}
+
+my %projects;
+
+sub run_tests {
+ my $self = shift;
+ my $job = shift;
+ my $request = @_ ? shift : thaw( $job->arg );
+ my %ORIGINAL_ENV = %ENV;
+
+ # Read data out of the hash they passed in
+ my $project = $request->{project};
+ my $url = $request->{repository_url};
+ my $sha = $request->{sha};
+ my $config = $request->{configure_cmd} || '';
+ my $env = $request->{env} || '';
+ my $jobs = $request->{parallel} ? $self->max_jobs : 1;
+ my $tests = $request->{test_glob} || 't/*.t';
+
+ # Clone ourselves a copy if need be
+ if (-d $project) {
+ warn "Updating $project\n";
+ chdir($project);
+ system("git", "remote", "update");
+ } else {
+ warn "Cloning $project\n";
+ system("git", "clone", "--quiet", $url, $project);
+ chdir($project);
+ }
+
+ # Check the SHA and check it out
+ if (system("git", "rev-parse", "-q", "--verify", $sha)) {
+ warn "No such SHA $sha in $project!\n";
+ my $result = {
+ smoke_id => $request->{smoke_id},
+ error => "Can't find SHA",
+ };
+ $self->client->do_task(post_results => freeze($result));
+ chdir("..");
+ return undef;
+ }
+ system("git", "checkout", "-q", $sha);
+
+ # Set up the environment
+ for my $line (split /\n/, $env) {
+ $line =~ s/\s*$//;
+ my ($var, $val) = split /\s*[:=\s]\s*/, $line, 2;
+ warn "Setting $var=$val\n";
+ $ENV{$var} = $val;
+ }
+
+ # Run configure
+ if ($config =~ /\S/) {
+ $config =~ s/\s*;?\s*\n+/ && /g;
+ my $output = `($config) 2>&1`;
+ my $ret = $?;
+ if ($ret) {
+ my $exit_val = $ret >> 8;
+ warn "Return value of $config from $project = $exit_val\n$output\n";
+ my $result = {
+ smoke_id => $request->{smoke_id},
+ error => "Configuration failed (exit value $exit_val)!\n"
+ . $output,
+ };
+ $self->client->do_task(post_results => freeze($result));
+
+ system("git", "clean", "-fxdq");
+ chdir("..");
+ return;
+ }
+ }
+
+ # Set up initial state for cleaning purposes
+ my @cleaners = map {"Smokingit::Worker::Clean::$_"->new}
+ qw/TmpFiles Postgres Mysql/;
+
+ # Run the tests
+ my $done = 0;
+ my @tests = glob($tests);
+ my $harness = TAP::Harness->new( {
+ jobs => $jobs,
+ lib => [".", "lib"],
+ } );
+ $harness->callback(
+ after_test => sub {
+ $job->set_status(++$done,scalar(@tests));
+ }
+ );
+ my $aggregator = do {
+ # Runtests apparently grows PERL5LIB -- local it so it doesn't
+ # grow without bound
+ local $ENV{PERL5LIB} = $ENV{PERL5LIB};
+ $harness->runtests(@tests);
+ };
+
+ # Shove back the frozen aggregator, stripping out the iterator
+ # coderefs first
+ $aggregator->{parser_for}{$_}{_iter} = undef
+ for keys %{$aggregator->{parser_for}};
+ my $result = {
+ smoke_id => $request->{smoke_id},
+ aggregator => $aggregator,
+ };
+ $self->client->do_task(post_results => freeze($result))
+ or die "Can't send task!";
+
+ # Clean out
+ system("git", "clean", "-fxdq");
+ $_->clean for @cleaners;
+ chdir("..");
+}
+
+1;
diff --git a/lib/Smokingit/Worker/Clean.pm b/lib/Smokingit/Worker/Clean.pm
new file mode 100644
index 0000000..4626ed0
--- /dev/null
+++ b/lib/Smokingit/Worker/Clean.pm
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+
+package Smokingit::Worker::Clean;
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+}
+
+sub clean {
+}
+
+1;
diff --git a/lib/Smokingit/Worker/Clean/Mysql.pm b/lib/Smokingit/Worker/Clean/Mysql.pm
new file mode 100644
index 0000000..ec00a43
--- /dev/null
+++ b/lib/Smokingit/Worker/Clean/Mysql.pm
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+
+package Smokingit::Worker::Clean::Mysql;
+use base 'Smokingit::Worker::Clean';
+use DBI;
+
+sub new {
+ my $class = shift;
+ my %args = (
+ user => "root",
+ password => "",
+ @_,
+ );
+ my $self = $class->SUPER::new();
+ $self->{$_} = $args{$_} for qw/user password/;
+ $self->{dbs}{$_}++ for $self->list_dbs;
+ return $self;
+}
+
+sub clean {
+ my $self = shift;
+ my @dbs = grep !$self->{dbs}{ $_ }, $self->list_dbs;
+ return unless @dbs;
+
+ my $dbh = DBI->connect(
+ "dbi:mysql:",
+ $self->{user},
+ $self->{password},
+ {RaiseError => 1}
+ );
+ warn "DROP DATABASE $_\n" for @dbs;
+ $dbh->do("DROP DATABASE $_") for @dbs;
+}
+
+sub list_dbs {
+ my $self = shift;
+ local $@;
+ my @dbs = eval { DBI->data_sources(
+ "mysql", {
+ user => $self->{user},
+ password => $self->{password},
+ }
+ ) };
+ return map {s/^DBI:mysql:(.*)/$1/ ? $_ : () } grep defined, @dbs;
+}
+
+1;
+
diff --git a/lib/Smokingit/Worker/Clean/Postgres.pm b/lib/Smokingit/Worker/Clean/Postgres.pm
new file mode 100644
index 0000000..003f53e
--- /dev/null
+++ b/lib/Smokingit/Worker/Clean/Postgres.pm
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+package Smokingit::Worker::Clean::Postgres;
+use base 'Smokingit::Worker::Clean';
+use DBI;
+
+sub new {
+ my $class = shift;
+ my %args = (
+ user => "postgres",
+ password => "",
+ @_,
+ );
+ my $self = $class->SUPER::new();
+ $self->{$_} = $args{$_} for qw/user password/;
+ $self->{dbs}{$_}++ for $self->list_dbs;
+ return $self;
+}
+
+sub clean {
+ my $self = shift;
+ my @dbs = grep !$self->{dbs}{ $_ }, $self->list_dbs;
+ return unless @dbs;
+
+ my $dbh = DBI->connect(
+ "dbi:Pg:",
+ $self->{user},
+ $self->{password},
+ {RaiseError => 1}
+ );
+ warn "DROP DATABASE $_\n" for @dbs;
+ $dbh->do("DROP DATABASE $_") for @dbs;
+}
+
+sub list_dbs {
+ my $self = shift;
+ local $@;
+ my @dbs = eval { DBI->data_sources(
+ "Pg",
+ "user=$self->{user};password=$self->{password}",
+ ) };
+ return map {s/.*dbname=([^;]+).*/$1/ ? $_ : () } grep defined, @dbs;
+}
+
+1;
+
diff --git a/lib/Smokingit/Worker/Clean/TmpFiles.pm b/lib/Smokingit/Worker/Clean/TmpFiles.pm
new file mode 100644
index 0000000..396f61c
--- /dev/null
+++ b/lib/Smokingit/Worker/Clean/TmpFiles.pm
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+
+package Smokingit::Worker::Clean::TmpFiles;
+use base 'Smokingit::Worker::Clean';
+
+use constant TMPDIRS => [qw{/tmp /var/tmp}];
+use File::Find;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new();
+ $self->{files}{$_}++ for $self->file_list;
+ return $self;
+}
+
+sub clean {
+ my $self = shift;
+ my @destroy = grep !$self->{files}{$_}, file_list();
+ for (@destroy) {
+ if (-d $_) {
+ warn "RMDIR $_\n";
+ rmdir($_) or warn "Can't rmdir $_: $!";
+ } else {
+ warn "UNLINK $_\n";
+ unlink($_) or warn "Can't unlink $_: $!";
+ }
+ }
+}
+
+sub file_list {
+ my %open;
+ # Find all the open files under /tmp
+ $open{$_}++ for map {s/^n//;$_} grep {/^n(.*)/}
+ split /\n/, `lsof +D @{+TMPDIRS} -F 'n' 2>/dev/null`;
+
+ for my $file (keys %open) {
+ # Add the parent dirs, as well
+ $open{$file}++ while $file ne "/" and $file =~ s{/[^/]+$}{};
+ }
+
+ my @found;
+ finddepth(
+ {
+ preprocess => sub {
+ # Skip directories which had open files in them
+ return grep {-w $_ and not $open{$File::Find::dir."/".$_}} @_;
+ },
+ wanted => sub {
+ # Everything else gets listed
+ push @found, $File::Find::name;
+ }
+ },
+ @{+TMPDIRS}
+ );
+ return @found;
+}
+
+1;
commit 9313e6605ca0eaedd53ec0fb58dba5bdfd996e5d
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:18:03 2011 -0500
Factor out the smoke_id which is always returned
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
index de2130a..84ffc46 100644
--- a/lib/Smokingit/Worker.pm
+++ b/lib/Smokingit/Worker.pm
@@ -74,6 +74,8 @@ sub run_tests {
my $jobs = $request->{parallel} ? $self->max_jobs : 1;
my $tests = $request->{test_glob} || 't/*.t';
+ my $result = { smoke_id => $request->{smoke_id} };
+
# Clone ourselves a copy if need be
if (-d $project) {
warn "Updating $project\n";
@@ -88,10 +90,7 @@ sub run_tests {
# Check the SHA and check it out
if (system("git", "rev-parse", "-q", "--verify", $sha)) {
warn "No such SHA $sha in $project!\n";
- my $result = {
- smoke_id => $request->{smoke_id},
- error => "Can't find SHA",
- };
+ $result->{error} = "Can't find SHA";
$self->client->do_task(post_results => freeze($result));
chdir("..");
return undef;
@@ -114,11 +113,8 @@ sub run_tests {
if ($ret) {
my $exit_val = $ret >> 8;
warn "Return value of $config from $project = $exit_val\n$output\n";
- my $result = {
- smoke_id => $request->{smoke_id},
- error => "Configuration failed (exit value $exit_val)!\n"
- . $output,
- };
+ $result->{error} = "Configuration failed (exit value $exit_val)!\n\n"
+ . $output;
$self->client->do_task(post_results => freeze($result));
system("git", "clean", "-fxdq");
@@ -154,10 +150,7 @@ sub run_tests {
# coderefs first
$aggregator->{parser_for}{$_}{_iter} = undef
for keys %{$aggregator->{parser_for}};
- my $result = {
- smoke_id => $request->{smoke_id},
- aggregator => $aggregator,
- };
+ $result->{aggregator} = $aggregator;
$self->client->do_task(post_results => freeze($result))
or die "Can't send task!";
commit 33dd5ef1ff82a2b8fc368b21bb20cb1e7bc28b82
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:19:24 2011 -0500
More forcefully clean out working directories
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
index 84ffc46..9b72419 100644
--- a/lib/Smokingit/Worker.pm
+++ b/lib/Smokingit/Worker.pm
@@ -88,6 +88,7 @@ sub run_tests {
}
# Check the SHA and check it out
+ warn "Now testing:\n";
if (system("git", "rev-parse", "-q", "--verify", $sha)) {
warn "No such SHA $sha in $project!\n";
$result->{error} = "Can't find SHA";
@@ -95,6 +96,8 @@ sub run_tests {
chdir("..");
return undef;
}
+ system("git", "clean", "-fxdq");
+ system("git", "reset", "--hard", "HEAD", "--quiet");
system("git", "checkout", "-q", $sha);
# Set up the environment
@@ -118,6 +121,7 @@ sub run_tests {
$self->client->do_task(post_results => freeze($result));
system("git", "clean", "-fxdq");
+ system("git", "reset", "--hard", "HEAD");
chdir("..");
return;
}
@@ -156,6 +160,7 @@ sub run_tests {
# Clean out
system("git", "clean", "-fxdq");
+ system("git", "reset", "--hard", "HEAD");
$_->clean for @cleaners;
chdir("..");
}
commit 6d43432296e552ce51cacef95101a842df4679ab
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:20:27 2011 -0500
Refactor common code between Postgres and Mysql cleaner drivers
diff --git a/lib/Smokingit/Worker/Clean/Postgres.pm b/lib/Smokingit/Worker/Clean/Database.pm
similarity index 65%
copy from lib/Smokingit/Worker/Clean/Postgres.pm
copy to lib/Smokingit/Worker/Clean/Database.pm
index 003f53e..e62a45c 100644
--- a/lib/Smokingit/Worker/Clean/Postgres.pm
+++ b/lib/Smokingit/Worker/Clean/Database.pm
@@ -1,14 +1,17 @@
use strict;
use warnings;
-package Smokingit::Worker::Clean::Postgres;
+package Smokingit::Worker::Clean::Database;
use base 'Smokingit::Worker::Clean';
use DBI;
+sub user { die "!!!\n" }
+sub dsn { die "!!!\n" }
+
sub new {
my $class = shift;
my %args = (
- user => "postgres",
+ user => $class->user,
password => "",
@_,
);
@@ -24,7 +27,7 @@ sub clean {
return unless @dbs;
my $dbh = DBI->connect(
- "dbi:Pg:",
+ $self->dsn,
$self->{user},
$self->{password},
{RaiseError => 1}
@@ -33,15 +36,7 @@ sub clean {
$dbh->do("DROP DATABASE $_") for @dbs;
}
-sub list_dbs {
- my $self = shift;
- local $@;
- my @dbs = eval { DBI->data_sources(
- "Pg",
- "user=$self->{user};password=$self->{password}",
- ) };
- return map {s/.*dbname=([^;]+).*/$1/ ? $_ : () } grep defined, @dbs;
-}
+sub list_dbs { die "!!!\n" }
1;
diff --git a/lib/Smokingit/Worker/Clean/Mysql.pm b/lib/Smokingit/Worker/Clean/Mysql.pm
index ec00a43..2a77f0e 100644
--- a/lib/Smokingit/Worker/Clean/Mysql.pm
+++ b/lib/Smokingit/Worker/Clean/Mysql.pm
@@ -2,36 +2,11 @@ use strict;
use warnings;
package Smokingit::Worker::Clean::Mysql;
-use base 'Smokingit::Worker::Clean';
+use base 'Smokingit::Worker::Clean::Database';
use DBI;
-sub new {
- my $class = shift;
- my %args = (
- user => "root",
- password => "",
- @_,
- );
- my $self = $class->SUPER::new();
- $self->{$_} = $args{$_} for qw/user password/;
- $self->{dbs}{$_}++ for $self->list_dbs;
- return $self;
-}
-
-sub clean {
- my $self = shift;
- my @dbs = grep !$self->{dbs}{ $_ }, $self->list_dbs;
- return unless @dbs;
-
- my $dbh = DBI->connect(
- "dbi:mysql:",
- $self->{user},
- $self->{password},
- {RaiseError => 1}
- );
- warn "DROP DATABASE $_\n" for @dbs;
- $dbh->do("DROP DATABASE $_") for @dbs;
-}
+sub user { "root" }
+sub dsn { "dbi:mysql:" }
sub list_dbs {
my $self = shift;
diff --git a/lib/Smokingit/Worker/Clean/Postgres.pm b/lib/Smokingit/Worker/Clean/Postgres.pm
index 003f53e..4504838 100644
--- a/lib/Smokingit/Worker/Clean/Postgres.pm
+++ b/lib/Smokingit/Worker/Clean/Postgres.pm
@@ -2,36 +2,11 @@ use strict;
use warnings;
package Smokingit::Worker::Clean::Postgres;
-use base 'Smokingit::Worker::Clean';
+use base 'Smokingit::Worker::Clean::Database';
use DBI;
-sub new {
- my $class = shift;
- my %args = (
- user => "postgres",
- password => "",
- @_,
- );
- my $self = $class->SUPER::new();
- $self->{$_} = $args{$_} for qw/user password/;
- $self->{dbs}{$_}++ for $self->list_dbs;
- return $self;
-}
-
-sub clean {
- my $self = shift;
- my @dbs = grep !$self->{dbs}{ $_ }, $self->list_dbs;
- return unless @dbs;
-
- my $dbh = DBI->connect(
- "dbi:Pg:",
- $self->{user},
- $self->{password},
- {RaiseError => 1}
- );
- warn "DROP DATABASE $_\n" for @dbs;
- $dbh->do("DROP DATABASE $_") for @dbs;
-}
+sub user { "postgres" }
+sub dsn { "dbi:Pg:" }
sub list_dbs {
my $self = shift;
commit 93102b80dc24e2ba5439af19136cd25caa8b28ef
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:22:55 2011 -0500
Add missing require line for Mysql cleaner
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
index 9b72419..c85fcef 100644
--- a/lib/Smokingit/Worker.pm
+++ b/lib/Smokingit/Worker.pm
@@ -12,6 +12,7 @@ use YAML;
use Smokingit::Worker::Clean::TmpFiles;
use Smokingit::Worker::Clean::Postgres;
+use Smokingit::Worker::Clean::Mysql;
use fields qw(max_jobs repo_path client);
commit 60c5960f7144bc4d61a4b39b99c04d7f0e8339a1
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:23:37 2011 -0500
Bailing out causes a die to get thrown; catch and report this
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
index c85fcef..8057528 100644
--- a/lib/Smokingit/Worker.pm
+++ b/lib/Smokingit/Worker.pm
@@ -144,18 +144,22 @@ sub run_tests {
$job->set_status(++$done,scalar(@tests));
}
);
- my $aggregator = do {
+ my $aggregator = eval {
# Runtests apparently grows PERL5LIB -- local it so it doesn't
# grow without bound
local $ENV{PERL5LIB} = $ENV{PERL5LIB};
$harness->runtests(@tests);
};
+ if (not $aggregator) {
+ $result->{error} = "Testing bailed out!\n\n$@",
+ } else {
+ # Tests were successful! Shove back the frozen aggregator,
+ # stripping out the iterator coderefs first
+ $aggregator->{parser_for}{$_}{_iter} = undef
+ for keys %{$aggregator->{parser_for}};
+ $result->{aggregator} = $aggregator;
+ }
- # Shove back the frozen aggregator, stripping out the iterator
- # coderefs first
- $aggregator->{parser_for}{$_}{_iter} = undef
- for keys %{$aggregator->{parser_for}};
- $result->{aggregator} = $aggregator;
$self->client->do_task(post_results => freeze($result))
or die "Can't send task!";
commit 0dc3325bea32cfad42c9088e47a01c3d2a6bb5ea
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Jan 26 02:24:02 2011 -0500
Set a couple useful default Makefile.PL-related environment vars
diff --git a/lib/Smokingit/Worker.pm b/lib/Smokingit/Worker.pm
index 8057528..b1f0d02 100644
--- a/lib/Smokingit/Worker.pm
+++ b/lib/Smokingit/Worker.pm
@@ -101,6 +101,10 @@ sub run_tests {
system("git", "reset", "--hard", "HEAD", "--quiet");
system("git", "checkout", "-q", $sha);
+ # Default perl-related environment vars
+ $ENV{PERL_MM_USE_DEFAULT}=1;
+ $ENV{PERL_AUTOINSTALL}="--alldeps";
+
# Set up the environment
for my $line (split /\n/, $env) {
$line =~ s/\s*$//;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list