[Bps-public-commit] r15724 - in Test-Chimps-Client/branches/modern-tap: . lib/Test/Chimps

[alexmv at bestpractical.com]

Author: alexmv
Date: Wed Sep  3 16:39:52 2008
New Revision: 15724

Modified:
   Test-Chimps-Client/branches/modern-tap/Makefile.PL
   Test-Chimps-Client/branches/modern-tap/bin/chimps-smoker.pl
   Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Smoker.pm

Log:
 * Be smarter about dropping only new databases
 * Add a --jobs options for parallel testing

Modified: Test-Chimps-Client/branches/modern-tap/Makefile.PL
==============================================================================
--- Test-Chimps-Client/branches/modern-tap/Makefile.PL	(original)
+++ Test-Chimps-Client/branches/modern-tap/Makefile.PL	Wed Sep  3 16:39:52 2008
@@ -6,9 +6,11 @@
 
 # Specific dependencies
 requires('Class::Accessor');
+requires('DBI');
 requires('LWP::UserAgent');
+requires('HTTP::Request::Common');
 requires('Params::Validate');
-requires('Test::TAP::Model::Visual');
+requires('TAP::Harness::Archive');
 requires('YAML::Syck');
 
 build_requires('Test::Dependencies');

Modified: Test-Chimps-Client/branches/modern-tap/bin/chimps-smoker.pl
==============================================================================
--- Test-Chimps-Client/branches/modern-tap/bin/chimps-smoker.pl	(original)
+++ Test-Chimps-Client/branches/modern-tap/bin/chimps-smoker.pl	Wed Sep  3 16:39:52 2008
@@ -13,12 +13,14 @@
 my $iterations = 'inf';
 my $projects = 'all';
 my $help = 0;
+my $jobs = 1;
 
 GetOptions("server|s=s",      \$server,
            "config_file|c=s", \$config_file,
            "iterations|i=i",  \$iterations,
            "projects|p=s",    \$projects,
-           "help|h",          \$help)
+           "help|h",          \$help,
+           "jobs|j",          \$jobs)
   || pod2usage(-exitval => 2,
                -verbose => 1);
 
@@ -45,11 +47,13 @@
 
 my $poller = Test::Chimps::Smoker->new(
   server      => $server,
-  config_file => $config_file
+  config_file => $config_file,
+  jobs        => $jobs,
 );
 
 $poller->smoke(iterations => $iterations,
-               projects => $projects);
+               projects => $projects,
+           );
   
 __DATA__
 
@@ -60,7 +64,7 @@
 =head1 SYNOPSIS
 
 chimps-smoker.pl --server SERVER --config_file CONFIG_FILE
-    [--iterations N] [--projects PROJECT1,PROJECT2,... ]
+    [--iterations N] [--projects PROJECT1,PROJECT2,... ] [--jobs n]
 
 This program is a wrapper around Test::Chimps::Smoker, which allows
 you to specify common options on the command line.
@@ -89,6 +93,10 @@
 A comma-separated list of projects to smoke.  If the string 'all'
 is provided, all projects will be smoked.  Defaults to 'all'.
 
+=head2 --jobs, -j
+
+The number of parallel processes to use when running tests.
+
 =head1 AUTHOR
 
 Zev Benjamin C<< zev at cpan.org >>

Modified: Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Smoker.pm
==============================================================================
--- Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Smoker.pm	(original)
+++ Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Smoker.pm	Wed Sep  3 16:39:52 2008
@@ -93,7 +93,13 @@
       projects => {
         optional => 1,
         default  => 'all'
-      }
+      },
+      jobs => {
+        optional => 1,
+        type     => SCALAR,
+        regex    => qr/^\d+$/,
+        default  => 1,
+      },
     },
     called => 'The Test::Chimps::Smoker constructor'
   );
@@ -146,6 +152,7 @@
   my $committer = $1;
 
   $self->_checkout_project($config->{$project}, $revision);
+  my @dbs = $self->_list_dbs;
 
   print "running tests for $project\n";
   my $test_glob = $config->{$project}->{test_glob} || 't/*.t t/*/t/*.t';
@@ -159,7 +166,8 @@
           osname    => $Config{osname},
           osvers    => $Config{osvers},
           archname  => $Config{archname},
-      }
+      },
+      jobs => $self->{jobs},
   } );
   $harness->runtests(glob($test_glob));
 
@@ -178,7 +186,7 @@
   }
   $self->_checkout_paths([]);
 
-  $self->_clean_dbs;
+  $self->_clean_dbs(@dbs);
 
   my $client = Test::Chimps::Client->new(
     archive => $tmpfile,
@@ -353,13 +361,18 @@
   return $projectdir;
 }
 
+sub _list_dbs {
+    local $ENV{DBI_USER} = "postgres";
+    return map {s/.*dbname=(.*)/$1/ ? $_ : () }
+        DBI->data_sources("Pg");
+}
+
 sub _clean_dbs {
-    my %skip = map {$_ => 1} (qw/postgres template0 template1 smoke jifty jiftydbitestdb/);
+    my %skip = map {($_ => 1)} @_;
 
-    $ENV{DBI_USER} = "postgres";
+    local $ENV{DBI_USER} = "postgres";
     my @dbs = grep {not $skip{$_}} 
-              map {s/.*dbname=(.*)/$1/; $_}
-              DBI->data_sources("Pg");
+              _list_dbs();
 
     my $dbh = DBI->connect("dbi:Pg:dbname=template1","postgres","",{RaiseError => 1});
     $dbh->do("DROP DATABASE $_") for @dbs;