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

[alexmv at bestpractical.com]

Author: alexmv
Date: Fri Aug 29 14:57:25 2008
New Revision: 15645

Modified:
   Test-Chimps-Client/branches/modern-tap/   (props changed)
   Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Client.pm
   Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Smoker.pm

Log:
 r36725 at kohr-ah:  chmrr | 2008-08-29 14:52:33 -0400
  * Submit a TAP::Harness::Archive file


Modified: Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Client.pm
==============================================================================
--- Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Client.pm	(original)
+++ Test-Chimps-Client/branches/modern-tap/lib/Test/Chimps/Client.pm	Fri Aug 29 14:57:25 2008
@@ -5,10 +5,11 @@
 
 use Carp;
 use Params::Validate qw/:all/;
+use HTTP::Request::Common;
 use LWP::UserAgent;
 use Storable qw/nfreeze/;
 
-use constant PROTO_VERSION => 0.2;
+use constant PROTO_VERSION => 1.0;
 
 =head1 NAME
 
@@ -20,7 +21,7 @@
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.10';
 
 =head1 SYNOPSIS
 
@@ -55,11 +56,7 @@
 
 =over 4
 
-=item * compress
-
-Optional.  Does not currently work
-
-=item * model
+=item * file
 
 Mandatory.  The value must be a C<Test::TAP::Model>.  These are the
 test results that will be submitted to the server.
@@ -79,7 +76,7 @@
 
 use base qw/Class::Accessor/;
 
-__PACKAGE__->mk_ro_accessors(qw/model server compress report_variables/);
+__PACKAGE__->mk_ro_accessors(qw/archive server/);
 
 sub new {
   my $class = shift;
@@ -94,9 +91,8 @@
     params => \@_,
     called => 'The Test::Chimps::Client constructor',
     spec   => {
-      model            => { isa => 'Test::TAP::Model' },
+      archive          => { isa => 'File::Temp' },
       server           => 1,
-      compress         => 0,
       report_variables => {
         optional => 1,
         type     => HASHREF,
@@ -120,32 +116,36 @@
 =cut
 
 sub send {
-  my $self = shift;
-  
-  my $ua = LWP::UserAgent->new;
-  $ua->agent("Test-Chimps-Client/" . PROTO_VERSION);
-  $ua->env_proxy;
-
-  my %request = (upload => 1, version => PROTO_VERSION,
-                 model_structure => nfreeze($self->model->structure),
-                 report_variables => nfreeze($self->report_variables));
-
-  my $resp = $ua->post($self->server => \%request);
-  if($resp->is_success) {
-    if($resp->content =~ /^ok/) {
-      return (1, '');
+    my $self = shift;
+
+    my $ua = LWP::UserAgent->new;
+    $ua->agent( "Test-Chimps-Client/" . PROTO_VERSION );
+    $ua->env_proxy;
+
+    my $resp = $ua->post(
+        $self->server,
+        Content_Type => 'form-data',
+        Content      => [
+            upload  => 1,
+            archive => [ "$self->{archive}" ],
+            version => PROTO_VERSION
+        ],
+    );
+
+    if ( $resp->is_success ) {
+        if ( $resp->content =~ /^ok/ ) {
+            return ( 1, '' );
+        } else {
+            return ( 0, $resp->content );
+        }
     } else {
-      return (0, $resp->content);
+        return ( 0, $resp->status_line );
     }
-  } else {
-    return (0, $resp->status_line);
-  }
 }
 
 =head1 ACCESSORS
 
-There are read-only accessors for compress, model,
-report_variables, and server.
+There are read-only accessors for model, report_variables, and server.
 
 =head1 AUTHOR
 

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	Fri Aug 29 14:57:25 2008
@@ -9,7 +9,7 @@
 use File::Temp qw/tempdir/;
 use Params::Validate qw/:all/;
 use Test::Chimps::Client;
-use Test::TAP::Model::Visual;
+use TAP::Harness::Archive;
 use YAML::Syck;
 
 use DBI;
@@ -145,22 +145,23 @@
   $info_out =~ m/^Last Changed Author: (\w+)/m;
   my $committer = $1;
 
-  $config->{$project}->{revision} = $revision;
-
   $self->_checkout_project($config->{$project}, $revision);
 
-  my $model;
   print "running tests for $project\n";
   my $test_glob = $config->{$project}->{test_glob} || 't/*.t t/*/t/*.t';
-  eval {
-    $model = Test::TAP::Model::Visual->new_with_tests(glob($test_glob));
-  };
-
-  if ($@) {
-    print "Tests aborted: $@\n";
-  }
-
-  my $duration = $model->structure->{end_time} - $model->structure->{start_time};
+  my $tmpfile = File::Temp->new( SUFFIX => ".tar.gz" );
+  my $harness = TAP::Harness::Archive->new( {
+      archive          => $tmpfile,
+      extra_properties => {
+          project   => $project,
+          revision  => $revision,
+          committer => $committer,
+          osname    => $Config{osname},
+          osvers    => $Config{osvers},
+          archname  => $Config{archname},
+      }
+  } );
+  $harness->runtests(glob($test_glob));
 
   $self->_unroll_env_stack;
 
@@ -180,16 +181,7 @@
   $self->_clean_dbs;
 
   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}
-    },
+    archive => $tmpfile,
     server => $self->server
   );
 
@@ -203,7 +195,9 @@
 
   if ($status) {
     print "Sumbitted smoke report for $project revision $revision\n";
-    DumpFile($self->config_file, $config);
+    $self->_config(LoadFile($self->config_file));
+    $self->_config->{$project}->{revision} = $revision;
+    DumpFile($self->config_file, $self->_config);
     return 1;
   } else {
     print "Error: the server responded: $msg\n";