[Catalyst-commits] r9451 - in trunk/examples/SmokeServer: . lib
script
t0m at dev.catalyst.perl.org
t0m at dev.catalyst.perl.org
Sat Mar 7 19:49:58 GMT 2009
Author: t0m
Date: 2009-03-07 19:49:57 +0000 (Sat, 07 Mar 2009)
New Revision: 9451
Added:
trunk/examples/SmokeServer/lib/SmokeRepos.pm
trunk/examples/SmokeServer/script/smokeserver_repository.pl
Modified:
trunk/examples/SmokeServer/Makefile.PL
Log:
Nick the useful bits of Test::Chimps::Client, all working bar module/version data.
Modified: trunk/examples/SmokeServer/Makefile.PL
===================================================================
--- trunk/examples/SmokeServer/Makefile.PL 2009-03-07 19:12:37 UTC (rev 9450)
+++ trunk/examples/SmokeServer/Makefile.PL 2009-03-07 19:49:57 UTC (rev 9451)
@@ -3,6 +3,7 @@
name 'SmokeServer';
all_from 'lib/SmokeServer.pm';
+requires 'YAML::Syck';
requires Catalyst => '5.64';
requires 'DBIx::Class' => '0.08012';
requires 'Test::TAP::HTMLMatrix' => '0.05';
Added: trunk/examples/SmokeServer/lib/SmokeRepos.pm
===================================================================
--- trunk/examples/SmokeServer/lib/SmokeRepos.pm (rev 0)
+++ trunk/examples/SmokeServer/lib/SmokeRepos.pm 2009-03-07 19:49:57 UTC (rev 9451)
@@ -0,0 +1,542 @@
+package SmokeRepos;
+
+use warnings;
+use strict;
+
+use Config;
+use File::Basename;
+use File::Path;
+use File::Temp qw/tempdir/;
+use Params::Validate qw/:all/;
+use Test::TAP::Model;
+use Test::TAP::Model::Smoke;
+use YAML::Syck;
+
+=head1 NAME
+
+
+SmokeRepos - Poll a set of SVN repositories and run tests when they change
+
+=head1 SYNOPSIS
+
+This module gives you everything you need to make your own build
+slave. You give it a configuration file describing all of your
+projects and how to test them, and it will monitor the SVN
+repositories, check the projects out (and their dependencies), test
+them, and submit the report to a server.
+
+ use SmokeRepos;
+
+ my $poller = SmokeRepos->new(
+ server => 'http://www.example.com/smoke_server',
+ config_file => '/path/to/configfile.yml'
+
+
+ $poller->poll();
+
+=head1 METHODS
+
+=head2 new ARGS
+
+Creates a new Client object. ARGS is a hash whose valid keys are:
+
+=over 4
+
+=item * config_file
+
+Mandatory. The configuration file describing which repositories to
+monitor. The format of the configuration is described in
+L</"CONFIGURATION FILE">.
+
+=item * server
+
+Mandatory. The URI of the server to upload the reports to.
+
+=item * simulate
+
+Don't actually submit the smoke reports, just run the tests. This
+I<does>, however, increment the revision numbers in the config
+file.
+
+=back
+
+=cut
+
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_ro_accessors(qw/server config_file simulate/);
+__PACKAGE__->mk_accessors(
+ qw/_added_to_inc _env_stack _checkout_paths _config projects iterations/);
+
+# add a signal handler so destructor gets run
+$SIG{INT} = sub {print "caught sigint. cleaning up...\n"; exit(1)};
+
+sub new {
+ 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'
+ }
+ },
+ called => 'The SmokeRepos constructor'
+ );
+
+ foreach my $key (keys %args) {
+ $self->{$key} = $args{$key};
+ }
+ $self->_added_to_inc([]);
+ $self->_env_stack([]);
+ $self->_checkout_paths([]);
+
+ $self->_config(LoadFile($self->config_file));
+}
+
+sub DESTROY {
+ my $self = shift;
+ foreach my $tmpdir (@{$self->_checkout_paths}) {
+ _remove_tmpdir($tmpdir);
+ }
+}
+
+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;
+
+ $config->{$project}->{revision} = $revision;
+
+ $self->_checkout_project($config->{$project}, $revision);
+
+ my $model;
+ {
+ local $SIG{ALRM} = sub { die "10 minute timeout exceeded" };
+ alarm 600;
+ print "running tests for $project\n";
+ eval {
+ $model = Test::TAP::Model->new_with_tests(glob("t/*.t t/*/t/*.t"));
+ };
+ alarm 0; # cancel alarm
+ }
+
+ if ($@) {
+ print "Tests aborted: $@\n";
+ }
+
+ my $duration = $model->structure->{end_time} - $model->structure->{start_time};
+
+ $self->_unroll_env_stack;
+
+ foreach my $libdir (@{$self->_added_to_inc}) {
+ print "removing $libdir from \@INC\n";
+ shift @INC;
+ }
+ $self->_added_to_inc([]);
+
+ chdir(File::Spec->rootdir);
+
+ foreach my $tmpdir (@{$self->_checkout_paths}) {
+ _remove_tmpdir($tmpdir);
+ }
+ $self->_checkout_paths([]);
+
+ #my $client = Test::Chimps::Client->new(
+ # model => $model,
+ # report_variables => {
+ # project => $project,
+ # revision => $revision,
+ # committer => $committer,
+ # duration => $duration,
+ # osname => $Config{osname},
+ # osvers => $Config{osvers},
+ # archname => $Config{archname}
+ # },
+ # server => $self->server
+ #);
+ my $report = Test::TAP::Model::Smoke->new( $model,
+ $project, $committer, $Config{osname}, $Config{osvers}, $Config{archname}
+ );
+
+ my ($status, $msg);
+ if ($self->simulate) {
+ $status = 1;
+ } else {
+ my $result = $report->upload($self->server . "/upload");
+ $status = 0;
+ $status = 1 if ($result->code == 200 && $result->content eq 'OK');
+ ($status, $msg) = ($status, $result->content);
+ }
+
+ if ($status) {
+ print "Sumbitted smoke report for $project revision $revision\n";
+ DumpFile($self->config_file, $config);
+ return 1;
+ } else {
+ print "Error: the server responded: $msg\n";
+ return 0;
+ }
+}
+
+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;
+ }
+ }
+}
+
+sub _smoke_projects {
+ my $self = shift;
+ my $projects = shift;
+ my $config = $self->_config;
+
+ foreach my $project (@$projects) {
+ $self->_smoke_once($project);
+ }
+}
+
+=head2 smoke PARAMS
+
+Calling smoke will cause the C<Smoker> object to continually poll
+repositories for changes in revision numbers. If an (actual)
+change is detected, the repository will be checked out (with
+dependencies), built, and tested, and the resulting report will be
+submitted to the server. This method may not return. Valid
+options to smoke are:
+
+=over 4
+
+=item * iterations
+
+Specifies the number of iterations to run. This is the number of
+smoke reports to generate per project. A value of 'inf' means to
+continue smoking forever. Defaults to 'inf'.
+
+=item * projects
+
+An array reference specifying which projects to smoke. If the
+string 'all' is provided instead of an array reference, all
+projects will be smoked. Defaults to 'all'.
+
+=back
+
+=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);
+
+}
+
+sub _validate_projects_opt {
+ my ($self, $projects) = @_;
+ return if $projects eq 'all';
+
+ 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);
+ unshift @{$self->_checkout_paths}, $tmpdir;
+
+ system("svn", "co", "-r", $revision, $project->{svn_uri}, $tmpdir);
+
+ $self->_push_onto_env_stack($project->{env});
+
+ my $projectdir = File::Spec->catdir($tmpdir, $project->{root_dir});
+
+ if (defined $project->{dependencies}) {
+ foreach my $dep (@{$project->{dependencies}}) {
+ print "processing dependency $dep\n";
+ $self->_checkout_project($self->_config->{$dep}, 'HEAD');
+ }
+ }
+
+ chdir($projectdir);
+
+ my $old_perl5lib = $ENV{PERL5LIB};
+ $ENV{PERL5LIB} = join($Config{path_sep}, @{$self->_added_to_inc}) .
+ ':' . $ENV{PERL5LIB};
+ if (defined $project->{configure_cmd}) {
+ system($project->{configure_cmd});
+ }
+ $ENV{PERL5LIB} = $old_perl5lib;
+
+ for my $libloc (qw{blib/lib}) {
+ my $libdir = File::Spec->catdir($tmpdir,
+ $project->{root_dir},
+ $libloc);
+ print "adding $libdir to \@INC\n";
+ unshift @{$self->_added_to_inc}, $libdir;
+ unshift @INC, $libdir;
+ }
+
+
+ return $projectdir;
+}
+
+sub _remove_tmpdir {
+ my $tmpdir = shift;
+ print "removing temporary directory $tmpdir\n";
+ 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;
+
+ 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;
+ }
+ 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};
+ }
+ }
+ }
+}
+
+=head1 ACCESSORS
+
+There are read-only accessors for server, config_file, and simulate.
+
+=head1 CONFIGURATION FILE
+
+The configuration file is YAML dump of a hash. The keys at the top
+level of the hash are project names. Their values are hashes that
+comprise the configuration options for that project.
+
+Perhaps an example is best. A typical configuration file might
+look like this:
+
+ ---
+ Some-jifty-project:
+ configure_cmd: perl Makefile.PL --skipdeps && make
+ dependencies:
+ - Jifty
+ revision: 555
+ root_dir: trunk/foo
+ svn_uri: svn+ssh://svn.example.com/svn/foo
+ Jifty:
+ configure_cmd: perl Makefile.PL --skipdeps && make
+ dependencies:
+ - Jifty-DBI
+ revision: 1332
+ root_dir: trunk
+ svn_uri: svn+ssh://svn.jifty.org/svn/jifty.org/jifty
+ Jifty-DBI:
+ configure_cmd: perl Makefile.PL --skipdeps && make
+ env:
+ JDBI_TEST_MYSQL: jiftydbitestdb
+ JDBI_TEST_MYSQL_PASS: ''
+ JDBI_TEST_MYSQL_USER: jiftydbitest
+ JDBI_TEST_PG: jiftydbitestdb
+ JDBI_TEST_PG_USER: jiftydbitest
+ revision: 1358
+ root_dir: trunk
+ svn_uri: svn+ssh://svn.jifty.org/svn/jifty.org/Jifty-DBI
+
+The supported project options are as follows:
+
+=over 4
+
+=item * configure_cmd
+
+The command to configure the project after checkout, but before
+running tests.
+
+=item * revision
+
+This is the last revision known for a given project. When started,
+the poller will attempt to checkout and test all revisions (besides
+ones on which the directory did not change) between this one and
+HEAD. When a test has been successfully uploaded, the revision
+number is updated and the configuration file is re-written.
+
+=item * root_dir
+
+The subdirectory inside the repository where configuration and
+testing commands should be run.
+
+=item * svn_uri
+
+The subversion URI of the project.
+
+=item * env
+
+A hash of environment variable names and values that are set before
+configuration, and reverted to their previous values after the
+tests have been run. In addition, if environment variable FOO's
+new value contains the string "$FOO", then the old value of FOO
+will be substituted in when setting the environment variable.
+
+=item * dependencies
+
+A list of project names that are dependencies for the given
+project. All dependencies are checked out at HEAD, have their
+configuration commands run, and all dependencys' $root_dir/blib/lib
+directories are added to @INC before the configuration command for
+the project is run.
+
+=item * dependency_only
+
+Indicates that this project should not be tested. It is only
+present to serve as a dependency for another project.
+
+=back
+
+=head1 REPORT VARIABLES
+
+This module assumes the use of the following report variables:
+
+ project
+ revision
+ committer
+ duration
+ osname
+ osvers
+ archname
+
+=head1 ORIGINAL AUTHOR
+
+Zev Benjamin, C<< <zev at cpan.org> >>
+
+=head1 AUTHOR
+
+Stolen almost wholesale from the L<Test::Chimps::Client> distribution
+by Tomas Doran (t0m)
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
+
Added: trunk/examples/SmokeServer/script/smokeserver_repository.pl
===================================================================
--- trunk/examples/SmokeServer/script/smokeserver_repository.pl (rev 0)
+++ trunk/examples/SmokeServer/script/smokeserver_repository.pl 2009-03-07 19:49:57 UTC (rev 9451)
@@ -0,0 +1,105 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use SmokeRepos;
+use File::Spec;
+use Getopt::Long;
+use Pod::Usage;
+
+my $server;
+my $config_file = File::Spec->catfile($ENV{HOME}, 'smoker-config.yml');
+my $iterations = 'inf';
+my $projects = 'all';
+my $help = 0;
+
+GetOptions("server|s=s", \$server,
+ "config_file|c=s", \$config_file,
+ "iterations|i=i", \$iterations,
+ "projects|p=s", \$projects,
+ "help|h", \$help)
+ || pod2usage(-exitval => 2,
+ -verbose => 1);
+
+
+if ($help) {
+ pod2usage(-exitval => 1,
+ -verbose => 2,
+ -noperldoc => 1);
+}
+
+if (! defined $server) {
+ print "You must specify a server to upload results to\n";
+ exit 2;
+}
+
+if (! defined $server) {
+ print "You must specify a configuration file\n";
+ exit 2;
+}
+
+if ($projects ne 'all') {
+ $projects = [split /,/, $projects];
+}
+
+my $poller = SmokeRepos->new(
+ server => $server,
+ config_file => $config_file
+);
+
+$poller->smoke(iterations => $iterations,
+ projects => $projects);
+
+__DATA__
+
+=head1 NAME
+
+chimps-smoker.pl - continually smoke projects
+
+=head1 SYNOPSIS
+
+chimps-smoker.pl --server SERVER --config_file CONFIG_FILE
+ [--iterations N] [--projects PROJECT1,PROJECT2,... ]
+
+This program is a wrapper around SmokeRepos, which allows
+you to specify common options on the command line.
+
+=head1 ARGUMENTS
+
+=head2 --config_file, -c
+
+Specifies the path to the configuration file. For more information
+about the configuration file format, see L<SmokeRepos>.
+
+=head2 --server, -s
+
+Specifies the full path to the chimps server CGI.
+
+=head1 OPTIONS
+
+=head2 --iterations, -i
+
+Specifies the number of iterations to run. This is the number of
+smoke reports to generate per project. A value of 'inf' means to
+continue smoking forever. Defaults to 'inf'.
+
+=head2 --projects, -p
+
+A comma-separated list of projects to smoke. If the string 'all'
+is provided, all projects will be smoked. Defaults to 'all'.
+
+=head1 AUTHOR
+
+Zev Benjamin C<< zev at cpan.org >>
+
+Copied from the L<Test::Chimps::Smoker> distribution by Tomas Doran (t0m)
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Property changes on: trunk/examples/SmokeServer/script/smokeserver_repository.pl
___________________________________________________________________
Name: svn:executable
+ *
More information about the Catalyst-commits
mailing list