[Rt-commit] r5427 - in Test-Chimps: trunk trunk/bin trunk/examples trunk/lib/Test/Smoke/Report

zev at bestpractical.com zev at bestpractical.com
Fri Jun 23 17:33:10 EDT 2006


Author: zev
Date: Fri Jun 23 17:33:07 2006
New Revision: 5427

Modified:
   Test-Chimps/   (props changed)
   Test-Chimps/trunk/Makefile.PL
   Test-Chimps/trunk/bin/poll_and_submit.pl
   Test-Chimps/trunk/examples/list.tmpl
   Test-Chimps/trunk/lib/Test/Smoke/Report/Server.pm

Log:
 r4191 at galvatron (orig r8):  zev | 2006-06-20 17:58:34 -0400
  r4171 at galvatron:  zev | 2006-06-20 17:58:14 -0400
  polling does dependencies, fixed extra validation, sort by date and revision
 


Modified: Test-Chimps/trunk/Makefile.PL
==============================================================================
--- Test-Chimps/trunk/Makefile.PL	(original)
+++ Test-Chimps/trunk/Makefile.PL	Fri Jun 23 17:33:07 2006
@@ -6,6 +6,8 @@
 
 # Specific dependencies
 requires('Algorithm::TokenBucket');
+requires('Date::Parse');
+requires('DateTime');
 requires('HTML::Mason');
 requires('LWP::UserAgent');
 requires('Module::CoreList');

Modified: Test-Chimps/trunk/bin/poll_and_submit.pl
==============================================================================
--- Test-Chimps/trunk/bin/poll_and_submit.pl	(original)
+++ Test-Chimps/trunk/bin/poll_and_submit.pl	Fri Jun 23 17:33:07 2006
@@ -11,60 +11,128 @@
 use File::Temp qw/tempdir/;
 use File::Path;
 
-my $config = LoadFile("/home/zev/bps/poll-config.yml");
+our $config = LoadFile("/home/zev/bps/poll-config.yml");
+
+our @added_to_inc;
+our @added_to_env;
+our @checkout_paths;
+
+END {
+  foreach my $tmpdir (@checkout_paths) {
+    remove_tmpdir($tmpdir);
+  }
+}
 
 while (1) {
-  foreach my $category (keys %{$config}) {
-    my $info_out = `svn info $config->{$category}->{svn_uri}`;
+  foreach my $project (keys %{$config}) {
+    next if $config->{$project}->{dependency_only};
+    
+    my $info_out = `svn info $config->{$project}->{svn_uri}`;
     $info_out =~ m/Revision: (\d+)/;
     my $revision = $1;
     $info_out =~ m/Last Changed Author: (\w+)/;
     my $author = $1;
 
-    next unless $revision > $config->{$category}->{revision};
-
-    $config->{$category}->{revision} = $revision;
-
-    my $tmpdir = tempdir("smoke-svn-XXXXXXX", TMPDIR => 1);
+    next unless $revision > $config->{$project}->{revision};
 
-    system("svn co $config->{$category}->{svn_uri} $tmpdir > /dev/null");
-
-    chdir(File::Spec->catdir($tmpdir, $config->{$category}->{root_dir}));
-    my $libdir = File::Spec->catdir($tmpdir,
-                                    $config->{$category}->{root_dir},
-                                    'lib');
-
-    unshift @INC, $libdir;
+    $config->{$project}->{revision} = $revision;
 
+    checkout_project($config->{$project});
+    
     my $start_time = time;
     my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t t/*/t/*.t"));
     my $duration = time - $start_time;
 
-    shift @INC;
+    foreach my $var (@added_to_env) {
+      print "unsetting environment variable $var\n";
+      delete $ENV{$var};
+    }
+    @added_to_env = ();
+
+    foreach my $libdir (@added_to_inc) {
+      print "removing $libdir from \@INC\n";
+      shift @INC;
+    }
+    @added_to_inc = ();
 
     chdir(File::Spec->rootdir);
-    rmtree($tmpdir, 0, 0);
-  
+
+    foreach my $tmpdir (@checkout_paths) {
+      remove_tmpdir($tmpdir);
+    }
+    @checkout_paths = ();
+    
     my $report = Test::Smoke::Report->new(model => $model,
                                           extra_data =>
-                                          { category => $category,
+                                          { category => $project,
                                             subcategory => 'repository snapshot / Linux',
-                                            project => scalar fileparse($config->{$category}->{svn_uri}),
+                                            project => scalar fileparse($config->{$project}->{svn_uri}),
                                             revision => $revision,
                                             author => $author,
                                             timestamp => scalar gmtime,
-                                            duration => $duration });
+                                            duration => $duration});
 
     my $client = Test::Smoke::Report::Client->new(reports => [$report],
                                                   server => 'http://galvatron.mit.edu/cgi-bin/report_server.pl');
 
     my ($status, $msg) = $client->send;
 
-    if (! $status) {
-      print "Error: $msg\n";
+    if ($status) {
+      print "Sumbitted smoke report for $project revision $revision\n";
+      DumpFile("/home/zev/bps/poll-config.yml", $config);
+    } else {
+      print "Error: the server responded: $msg\n";
+    }
+  }
+  sleep 60;
+}
+
+sub checkout_project {
+  my $project = shift;
+
+  my $tmpdir = tempdir("smoke-svn-XXXXXXX", TMPDIR => 1);
+  unshift @checkout_paths, $tmpdir;
+
+  system("svn", "co", $project->{svn_uri}, $tmpdir);
+
+  if (defined $project->{env}) {
+    foreach my $var (keys %{$project->{env}}) {
+      unshift @added_to_env, $var;
+      print "setting environment variable $var to $project->{env}->{$var}\n";
+      $ENV{$var} = $project->{env}->{$var};
     }
-    DumpFile("/home/zev/bps/poll-config.yml", $config);
   }
-  sleep 300;
+
+  my $projectdir = File::Spec->catdir($tmpdir, $project->{root_dir});
+
+  if (defined $project->{dependencies}) {
+    foreach my $dep (@{$project->{dependencies}}) {
+      print "processing dependency $dep\n";
+      checkout_project($config->{$dep});
+    }
+  }
+  
+  chdir($projectdir);
+
+  if (defined $project->{configure_cmd}) {
+    system($project->{configure_cmd});
+  }
+
+  for my $libloc (qw{blib/lib}) {
+    my $libdir = File::Spec->catdir($tmpdir,
+                                    $project->{root_dir},
+                                    $libloc);
+    print "adding $libdir to \@INC\n";
+    unshift @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);
+}

Modified: Test-Chimps/trunk/examples/list.tmpl
==============================================================================
--- Test-Chimps/trunk/examples/list.tmpl	(original)
+++ Test-Chimps/trunk/examples/list.tmpl	Fri Jun 23 17:33:07 2006
@@ -72,11 +72,12 @@
   </p>
  
   <table>
-% foreach my $category (keys %categories) {
+% foreach my $category (sort keys %categories) {
       <tr><th colspan="11" class="category"><% $category %></th></tr>
-% foreach my $subcategory (keys %{$categories{$category}}) {
+% foreach my $subcategory (sort keys %{$categories{$category}}) {
         <tr><th colspan="11" class="subcategory"><% $subcategory %></th></tr>
-% foreach my $report (@{$categories{$category}->{$subcategory}}) {
+% foreach my $report (sort by_revision_then_date
+%                          @{$categories{$category}->{$subcategory}}) {
 % my $id = $report->{id};
 % my $data = $report->extra_data;
 % my $model = Test::TAP::Model::Visual->new_with_struct($report->model_structure);
@@ -123,9 +124,24 @@
 </%args>
 
 <%init>
+use DateTime;
+use Date::Parse;
+
 my %categories;
 foreach my $report (@reports) {
   my $data = $report->extra_data;
   push @{$categories{$data->{category}}->{$data->{subcategory}}}, $report;
 }
+
+sub by_revision_then_date {
+  my $res = $b->extra_data->{revision} <=> $a->extra_data->{revision};
+
+  if ($res != 0) {
+    return $res;
+  }
+  
+  my ($adate, $bdate) = (DateTime->from_epoch(epoch => str2time($a->extra_data->{timestamp})),
+                         DateTime->from_epoch(epoch => str2time($b->extra_data->{timestamp})));
+  return DateTime->compare($bdate, $adate);
+}
 </%init>

Modified: Test-Chimps/trunk/lib/Test/Smoke/Report/Server.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Smoke/Report/Server.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Smoke/Report/Server.pm	Fri Jun 23 17:33:07 2006
@@ -218,7 +218,7 @@
   print $cgi->header("text/plain");
   $self->_limit_rate($cgi);
   $self->_validate_params($cgi);  
-  $self->_validate_extra($cgi);
+  $self->_extra_validation_spec($cgi);
   $self->_add_report($cgi);
   $self->_clean_old_reports($cgi);
 
@@ -276,21 +276,22 @@
 #  uncompress_smoke();
 }
 
-sub _validate_extra {
+sub _extra_validation_spec {
   my $self = shift;
   my $cgi = shift;
   
   my @reports = map { Load($_) } $cgi->param("reports");
   
-  if (defined $self->{validate_extra}) {
+  if (defined $self->{extra_validation_spec}) {
     foreach my $report (@reports) {
       eval {
-        validate(@{$report->{extra_data}}, $self->{validate_extra});
+        validate(@{[%{$report->{extra_data}}]}, $self->{extra_validation_spec});
       };
-      if ($@) {
+      if (defined $@ && $@) {
         # XXX: doesn't dump subroutines because we're using YAML::Syck
         print "This server accepts extra parameters.  It's validation ",
-          "string looks like this:\n", Dump($self->{validate_extra});
+          "string looks like this:\n", Dump($self->{extra_validation_spec}),
+          "\nYour extra data looks like this:\n", Dump($report->{extra_data});
         exit;
       }
 


More information about the Rt-commit mailing list