[Rt-commit] r5666 - in Test-Chimps-Client/trunk: . bin lib/Test/Chimps

[zev at bestpractical.com]

Author: zev
Date: Thu Jul 27 17:29:44 2006
New Revision: 5666

Added:
   Test-Chimps-Client/trunk/bin/
   Test-Chimps-Client/trunk/bin/chimps-smoker.pl   (contents, props changed)
Removed:
   Test-Chimps-Client/trunk/examples/chimps-smoker.pl
Modified:
   Test-Chimps-Client/trunk/   (props changed)
   Test-Chimps-Client/trunk/lib/Test/Chimps/Smoker.pm

Log:
 r11964 at truegrounds:  zev | 2006-07-27 17:29:38 -0400
 * bug fixes
 * made chimps-smoker a real binary (but it still needs docs)


Added: Test-Chimps-Client/trunk/bin/chimps-smoker.pl
==============================================================================
--- (empty file)
+++ Test-Chimps-Client/trunk/bin/chimps-smoker.pl	Thu Jul 27 17:29:44 2006
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Test::Chimps::Smoker;
+use File::Spec;
+use Getopt::Long;
+
+my $server;
+my $config_file = File::Spec->catfile($ENV{HOME}, 'smoker-config.yml');
+my $iterations = 'inf';
+my $projects = 'all';
+
+my $result = GetOptions("server|s=s", \$server,
+                        "config_file|c=s", \$config_file,
+                        "iterations|i=i", \$iterations,
+                        "projects|p=s", \$projects);
+if (! $result) {
+  print "Error during argument processing\n";
+  exit 1;
+}
+
+if (! defined $server) {
+  print "You must specify a server to upload results to\n";
+  exit 1;
+}
+
+if ($projects ne 'all') {
+  $projects = [split /,/, $projects];
+}
+
+my $poller = Test::Chimps::Smoker->new(
+  server      => $server,
+  config_file => $config_file
+);
+
+$poller->smoke(iterations => $iterations,
+               projects => $projects);

Modified: Test-Chimps-Client/trunk/lib/Test/Chimps/Smoker.pm
==============================================================================
--- Test-Chimps-Client/trunk/lib/Test/Chimps/Smoker.pm	(original)
+++ Test-Chimps-Client/trunk/lib/Test/Chimps/Smoker.pm	Thu Jul 27 17:29:44 2006
@@ -130,8 +130,10 @@
 
   return 0 unless $last_changed_revision > $old_revision;
 
+  my @revisions = (($old_revision + 1) .. $latest_revision);
   my $revision;
-  foreach $revision (($old_revision + 1) .. $latest_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);
@@ -285,9 +287,9 @@
     called => 'Test::Chimps::Smoker->smoke'
   );
 
-  $self->_validate_projects_opt;
   my $projects = $args{projects};
   my $iterations = $args{iterations};
+  $self->_validate_projects_opt($projects);
   
   if ($projects eq 'all') {
     $projects = [keys %$config];
@@ -298,7 +300,7 @@
 }
 
 sub _validate_projects_opt {
-  my ($self, $projects) = shift;
+  my ($self, $projects) = @_;
   return if $projects eq 'all';
 
   foreach my $project (@$projects) {