[Rt-commit] r5542 - in Test-Chimps/trunk: . examples lib/Test/Chimps lib/Test/Chimps/Client lib/Test/Chimps/Server

zev at bestpractical.com zev at bestpractical.com
Fri Jul 7 15:13:06 EDT 2006


Author: zev
Date: Fri Jul  7 15:12:56 2006
New Revision: 5542

Added:
   Test-Chimps/trunk/bin/yaml2dbi.pl   (contents, props changed)
   Test-Chimps/trunk/lib/Test/Chimps/ReportCollection.pm
Modified:
   Test-Chimps/trunk/   (props changed)
   Test-Chimps/trunk/bin/poll_and_submit.pl
   Test-Chimps/trunk/bin/report_server.pl
   Test-Chimps/trunk/examples/list.tmpl
   Test-Chimps/trunk/lib/Test/Chimps/Client.pm
   Test-Chimps/trunk/lib/Test/Chimps/Client/Poller.pm
   Test-Chimps/trunk/lib/Test/Chimps/Report.pm
   Test-Chimps/trunk/lib/Test/Chimps/Server.pm
   Test-Chimps/trunk/lib/Test/Chimps/Server/Lister.pm

Log:
 r11402 at galvatron:  zev | 2006-07-07 15:09:00 -0400
 * merging dbi branch into trunk


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 Jul  7 15:12:56 2006
@@ -6,9 +6,8 @@
 use Test::Chimps::Client::Poller;
   
 my $poller = Test::Chimps::Client::Poller->new(
-  server      => 'http://smoke.bestpractical.com/cgi-bin/report_server.pl',
+  server      => 'http://galvatron.mit.edu/cgi-bin/report_server.pl',
   config_file => "$ENV{HOME}/poll-config.yml",
-  simulate    => 1
 );
 
 $poller->poll;

Modified: Test-Chimps/trunk/bin/report_server.pl
==============================================================================
--- Test-Chimps/trunk/bin/report_server.pl	(original)
+++ Test-Chimps/trunk/bin/report_server.pl	Fri Jul  7 15:12:56 2006
@@ -1,19 +1,16 @@
 #!/usr/bin/env perl
 
-use lib '/home/zev/bps/Test-Chimps/branches/categories-rework/lib';
-
 use Test::Chimps::Server;
 
 my $server = Test::Chimps::Server->new(base_dir => '/var/www/bps-smokes',
-                                       list_template => 'list2.tmpl',
+                                       list_template => 'list.tmpl',
                                        variables_validation_spec =>
                                        { project => 1,
                                          revision => 1,
-                                         author => 1,
-                                         timestamp => 1,
+                                         committer => 1,
                                          duration => 1,
                                          osname => 1,
-                                         osver => 1,
+                                         osvers => 1,
                                          archname => 1
                                        });
 

Added: Test-Chimps/trunk/bin/yaml2dbi.pl
==============================================================================
--- (empty file)
+++ Test-Chimps/trunk/bin/yaml2dbi.pl	Fri Jul  7 15:12:56 2006
@@ -0,0 +1,110 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use lib '/home/zev/bps/Test-Chimps-dbi/lib';
+
+use YAML::Syck;
+use Jifty::DBI::Handle;
+use Jifty::DBI::SchemaGenerator;
+use IO::Dir;
+use File::Spec;
+use Test::TAP::Model::Visual;
+use Test::Chimps::Report;
+use DateTime;
+use Date::Parse;
+
+package Test::Chimps::Report::Schema;
+
+column($_, type(is('text'))) for (
+  qw/
+  project
+  revision
+  committer
+  timestamp
+  duration
+  osname
+  osvers
+  archname
+  /
+);
+
+package main;
+
+my $handle = Jifty::DBI::Handle->new();
+$handle->connect(driver => 'SQLite', database => '/home/zev/bps/database');
+my $sg = Jifty::DBI::SchemaGenerator->new($handle);
+$sg->add_model(Test::Chimps::Report->new(handle => $handle));
+  
+$handle->simple_query($_) for $sg->create_table_sql_statements;
+
+my $rec = Test::Chimps::Report->new(handle => $handle);
+
+my $dir = shift;
+my $d = IO::Dir->new($dir)
+  or die "Could not open report directory: $dir: $!";
+while (defined(my $entry = $d->read)) {
+  next unless $entry =~ m/\.yml$/;
+  my $report = LoadFile(File::Spec->catfile($dir, $entry));
+  my $params = {};
+
+  $params->{model_structure} = $report->{model_structure};
+  
+  foreach my $var (keys %{$report->{report_variables}}) {
+    $params->{$var} = $report->{report_variables}->{$var};
+  }
+  $params->{report_html} = $report->{report_text};
+
+  my $model = Test::TAP::Model::Visual->new_with_struct($report->{model_structure});
+  foreach my $var (
+    qw/
+    total_ok
+    total_passed
+    total_nok
+    total_failed
+    total_percentage
+    total_ratio
+    total_seen
+    total_skipped
+    total_todo
+    total_unexpectedly_succeeded
+    /)
+  {
+    $params->{$var} = $model->$var;
+  }
+
+  foreach my $var (qw/category subcategory/) {
+    delete $params->{$var};
+  }
+  
+  if (exists $params->{author}) {
+    $params->{committer} = $params->{author};
+    delete $params->{author};
+  }
+
+  if ($params->{project} eq 'BTDT') {
+    $params->{project} = 'Hiveminder';
+  }
+
+  if ($params->{project} eq 'trunk') {
+    if ($params->{revision} > 1750) {
+      $params->{project} = 'SVK-Trunk';
+    } else {
+      $params->{project} = 'Jifty';
+    }
+  }
+
+  if ($params->{project} eq '1.0-releng') {
+    $params->{project} = 'SVK-Releng';
+  }
+
+  $params->{project} =~ s/^\l(.)/\u$1/;
+
+  $params->{timestamp} =
+    DateTime->from_epoch(epoch => str2time($params->{timestamp}));
+
+
+   
+  $rec->create(%$params);
+}

Modified: Test-Chimps/trunk/examples/list.tmpl
==============================================================================
--- Test-Chimps/trunk/examples/list.tmpl	(original)
+++ Test-Chimps/trunk/examples/list.tmpl	Fri Jul  7 15:12:56 2006
@@ -77,37 +77,34 @@
 % foreach my $subcategory (sort keys %{$categories->{$category}}) {
         <tr><th colspan="11" class="subcategory"><% $subcategory %></th></tr>
 % foreach my $report (@{$categories->{$category}->{$subcategory}}) {
-% my $id = $report->{id};
-% my $data = $report->report_variables;
-% my $model = Test::TAP::Model::Visual->new_with_struct($report->model_structure);
           <tr>
-            <td class="report_summary"><% $data->{project} %></td>
+            <td class="report_summary"><% $report->project %></td>
             <td>
-              r<% $data->{revision} %>
+              r<% $report->revision %>
             </td>
-            <td class="leftsep"><% $data->{author} %></td>
-            <td class="leftsep"><% $data->{timestamp} %></td>
-            <td class="leftsep num"><% $data->{duration} %>&nbsp;sec</td>
-            <td class="leftsep num"><% sprintf("%.2f", $model->total_ratio * 100) %>%&nbsp;ok</td>
-	    <td class="leftsep num tests_total"><span title="<% $model->total_seen %> total"><% $model->total_seen %></span>:</td>
-	    <td class="num tests_ok"><span title="<% $model->total_ok %> ok"><% $model->total_ok %></span>,</td>
-	    <td class="num tests_failed"><span title="<% $model->total_failed %> failed"><% $model->total_failed %></span>,</td>
-	    <td class="num tests_todo"><span title="<% $model->total_todo %> todo"><% $model->total_todo %></span>,</td>
-	    <td class="num tests_skipped"><span title="<% $model->total_skipped %> skipped"><% $model->total_skipped %></span>,</td>
-	    <td class="num tests_unexpect"><span title="<% $model->total_unexpectedly_succeeded %> unexpectedly succeeded"><% $model->total_unexpectedly_succeeded %></span></td>
-	    <td><span title="Details" class="expander" onclick="toggle_visibility('<% $id %>')" id="expander_<% $id %>">&raquo;</span></td>
-	    <td><a style="text-decoration: none" href="<% $report->{url} %>" title="Full smoke report">&raquo;</a></td>
+            <td class="leftsep"><% $report->committer %></td>
+            <td class="leftsep"><% $report->timestamp %></td>
+            <td class="leftsep num"><% $report->duration %>&nbsp;sec</td>
+            <td class="leftsep num"><% sprintf("%.2f", $report->total_ratio * 100) %>%&nbsp;ok</td>
+	    <td class="leftsep num tests_total"><span title="<% $report->total_seen %> total"><% $report->total_seen %></span>:</td>
+	    <td class="num tests_ok"><span title="<% $report->total_ok %> ok"><% $report->total_ok %></span>,</td>
+	    <td class="num tests_failed"><span title="<% $report->total_failed %> failed"><% $report->total_failed %></span>,</td>
+	    <td class="num tests_todo"><span title="<% $report->total_todo %> todo"><% $report->total_todo %></span>,</td>
+	    <td class="num tests_skipped"><span title="<% $report->total_skipped %> skipped"><% $report->total_skipped %></span>,</td>
+	    <td class="num tests_unexpect"><span title="<% $report->total_unexpectedly_succeeded %> unexpectedly succeeded"><% $report->total_unexpectedly_succeeded %></span></td>
+	    <td><span title="Details" class="expander" onclick="toggle_visibility('<% $report->id %>')" id="expander_<% $report->id %>">&raquo;</span></td>
+	    <td><a style="text-decoration: none" href="<% detail_url($cgi, $report) %>" title="Full smoke report">&raquo;</a></td>
           </tr>
-          <tr class="details" id="details_<% $id %>">
+          <tr class="details" id="details_<% $report->id %>">
             <td colspan="11" class="report_details">
-                <span class="tests_total"><% $model->total_seen %> test cases</span>:<br />
-		<span class="tests_ok"><% $model->total_ok %> ok</span>,
-		<span class="tests_failed"><% $model->total_failed %> failed</span>,
-		<span class="tests_todo"><% $model->total_todo %> todo</span>,<br />
-                <span class="tests_skipped"><% $model->total_skipped %> skipped</span> and
-		<span class="tests_unexpect"><% $model->total_unexpectedly_succeeded %> unexpectedly succeeded</span>
+                <span class="tests_total"><% $report->total_seen %> test cases</span>:<br />
+		<span class="tests_ok"><% $report->total_ok %> ok</span>,
+		<span class="tests_failed"><% $report->total_failed %> failed</span>,
+		<span class="tests_todo"><% $report->total_todo %> todo</span>,<br />
+                <span class="tests_skipped"><% $report->total_skipped %> skipped</span> and
+		<span class="tests_unexpect"><% $report->total_unexpectedly_succeeded %> unexpectedly succeeded</span>
               <br />
-              <a href="<% $report->{url} %>" title="Full smoke report">View full smoke report</a>
+              <a href="<% detail_url($cgi, $report) %>" title="Full smoke report">View full smoke report</a>
             </td>
           </tr>
 % }
@@ -119,5 +116,12 @@
 
 <%args>
 $categories
+$cgi
 </%args>
 
+<%once>
+sub detail_url {
+  my ($cgi, $report) = @_;
+  return $cgi->url . "?id=" . $report->id;
+}
+</%once>

Modified: Test-Chimps/trunk/lib/Test/Chimps/Client.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Chimps/Client.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Chimps/Client.pm	Fri Jul  7 15:12:56 2006
@@ -7,13 +7,13 @@
 use Params::Validate qw/:all/;
 use Test::Chimps;
 use LWP::UserAgent;
-use YAML::Syck;
+use Storable qw/nfreeze/;
 
-use constant PROTO_VERSION => 0.1;
+use constant PROTO_VERSION => 0.2;
 
 =head1 NAME
 
-Test::Chimps::Client - Send a Test::Chimps::Report to a server
+Test::Chimps::Client - Send smoke test results to a server
 
 =head1 VERSION
 
@@ -25,10 +25,9 @@
 
 =head1 SYNOPSIS
 
-This module simplifies the process of sending C<Test::Chimps::Report>s to a
-smoke server.
+This module simplifies the process of sending smoke test results
+(in the form of C<Test::TAP::Model>s) to a smoke server.
 
-    use Test::Chimps::Report;
     use Test::Chimps::Client;
     use Test::TAP::Model::Visual;
 
@@ -36,10 +35,10 @@
 
     my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t"));
 
-    my $report = Test::Chimps::Report->new(model => $model);
-
-    my $client = Test::Chimps::Client->new(reports => [$report],
-                                           server => 'http://www.example.com/cgi-bin/smoke-server.pl');
+    my $client = Test::Chimps::Client->new(
+      server => 'http://www.example.com/cgi-bin/smoke-server.pl',
+      model  => $model
+    );
     
     my ($status, $msg) = $client->send;
     
@@ -61,15 +60,14 @@
 
 Optional.  Does not currently work
 
-=item * reports
+=item * model
 
-Mandatory.  The value must be an array reference which contains
-C<Test::Chimps>s.  These are the reports that will be
-submitted to the server.
+Mandatory.  The value must be a C<Test::TAP::Model>.  These are the
+test results that will be submitted to the server.
 
 =item * server
 
-Mandatory.  The URI of the server script to upload the reports to.
+Mandatory.  The URI of the server script to upload the model to.
 
 =back
 
@@ -77,7 +75,7 @@
 
 use base qw/Class::Accessor/;
 
-__PACKAGE__->mk_ro_accessors(qw/reports server compress/);
+__PACKAGE__->mk_ro_accessors(qw/model server compress report_variables/);
 
 sub new {
   my $class = shift;
@@ -88,29 +86,30 @@
 
 sub _init {
   my $self = shift;
-  validate_with(
+  my %args = validate_with(
     params => \@_,
     called => 'The Test::Chimps::Client constructor',
     spec   => {
-      reports  => { type => ARRAYREF },
-      server   => 1,
-      compress => 0
+      model            => { isa => 'Test::TAP::Model' },
+      server           => 1,
+      compress         => 0,
+      report_variables => {
+        optional => 1,
+        type     => HASHREF,
+        default  => {}
+      }
     }
   );
-  
-  my %args = @_;
-  $self->{reports} = $args{reports};
-  foreach my $report (@{$self->{reports}}) {
-    croak "one the the specified reports is not a Test::Chimps::Report"
-      if ! (ref $report && $report->isa('Test::Chimps::Report'));
+
+  foreach my $key (keys %args) {
+    $self->{$key} = $args{$key};
   }
-  $self->{server} = $args{server};
-  $self->{compress} = $args{compress} || 0;
+
 }
 
 =head2 send
 
-Submit the specified reports to the server.  This function's return
+Submit the specified model to the server.  This function's return
 value is a list, the first of which indicates success or failure,
 and the second of which is an error string.
 
@@ -123,9 +122,9 @@
   $ua->agent("Test-Chimps-Client/" . PROTO_VERSION);
   $ua->env_proxy;
 
-  my $serialized_reports = [ map { Dump($_) } @{$self->reports} ];
   my %request = (upload => 1, version => PROTO_VERSION,
-                 reports => $serialized_reports);
+                 model_structure => nfreeze($self->model->structure),
+                 report_variables => nfreeze($self->report_variables));
 
   my $resp = $ua->post($self->server => \%request);
   if($resp->is_success) {
@@ -141,7 +140,8 @@
 
 =head1 ACCESSORS
 
-There are read-only accessors for compress, reports, and server.
+There are read-only accessors for compress, model,
+report_variables, and server.
 
 =head1 AUTHOR
 

Modified: Test-Chimps/trunk/lib/Test/Chimps/Client/Poller.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Chimps/Client/Poller.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Chimps/Client/Poller.pm	Fri Jul  7 15:12:56 2006
@@ -38,7 +38,7 @@
     my $poller = Test::Chimps::Client::Poll->new(
       server      => 'http://www.example.com/cgi-bin/smoke-server.pl',
       config_file => '/path/to/configfile.yml'
-      )
+
 
     $poller->poll();
 
@@ -129,12 +129,10 @@
       next if $config->{$project}->{dependency_only};
     
       my $info_out = `svn info $config->{$project}->{svn_uri}`;
-      $info_out =~ m/Revision: (\d+)/;
+      $info_out =~ m/^Revision: (\d+)/m;
       my $latest_revision = $1;
-      $info_out =~ m/Last Changed Revision: (\d+)/;
+      $info_out =~ m/^Last Changed Rev: (\d+)/m;
       my $last_changed_revision = $1;
-      $info_out =~ m/Last Changed Author: (\w+)/;
-      my $author = $1;
 
       my $old_revision = $config->{$project}->{revision};
 
@@ -143,29 +141,32 @@
       foreach my $revision (($old_revision + 1) .. $latest_revision) {
         # only actually do the check out if the revision and last changed revision match for
         # a particular revision
-        next unless _revisions_match($config->{$project}->{svn_uri}, $revision);
-      
+        next unless _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;
-        my $duration;
         {
           local $SIG{ALRM} = sub { die "10 minute timeout exceeded" };
           alarm 600;
           print "running tests for $project\n";
-          my $start_time = time;
           eval {
             $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t t/*/t/*.t"));
           };
-          $duration = time - $start_time;
           alarm 0; # cancel alarm
         }
         
         if ($@) {
           print "Tests aborted: $@\n";
         }
+        
+        my $duration = $model->structure->{end_time} - $model->structure->{start_time};
 
         $self->_unroll_env_stack;
         
@@ -181,20 +182,17 @@
           _remove_tmpdir($tmpdir);
         }
         $self->_checkout_paths([]);
-    
-        my $report = Test::Chimps::Report->new(model => $model,
+
+        my $client = Test::Chimps::Client->new(model => $model,
                                                report_variables =>
                                                { project => $project,
                                                  revision => $revision,
-                                                 author => $author,
-                                                 timestamp => scalar gmtime,
+                                                 committer => $committer,
                                                  duration => $duration,
                                                  osname => $Config{osname},
-                                                 osver => $Config{osver},
+                                                 osvers => $Config{osvers},
                                                  archname => $Config{archname}
-                                               });
-
-        my $client = Test::Chimps::Client->new(reports => [$report],
+                                               },
                                                server => $self->server);
 
         my ($status, $msg);
@@ -266,14 +264,14 @@
   rmtree($tmpdir, 0, 0);
 }
 
-sub _revisions_match {
+sub _change_on_revision {
   my $uri = shift;
   my $revision = shift;
 
   my $info_out = `svn info -r $revision $uri`;
-  $info_out =~ m/Revision: (\d+)/;
+  $info_out =~ m/^Revision: (\d+)/m;
   my $latest_revision = $1;
-  $info_out =~ m/Last Changed Revision: (\d+)/;
+  $info_out =~ m/^Last Changed Rev: (\d+)/m;
   my $last_changed_revision = $1;
 
   return $latest_revision == $last_changed_revision;

Modified: Test-Chimps/trunk/lib/Test/Chimps/Report.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Chimps/Report.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Chimps/Report.pm	Fri Jul  7 15:12:56 2006
@@ -3,123 +3,66 @@
 use warnings;
 use strict;
 
-use Carp;
-use Params::Validate qw/:all/;
-use Test::TAP::HTMLMatrix;
-use YAML::Syck;
-
 =head1 NAME
 
 Test::Chimps::Report - Encapsulate a smoke test report
 
-=head1 VERSION
-
-Version 0.01
-
-=cut
-
-our $VERSION = '0.01';
-
 =head1 SYNOPSIS
 
-This module encapsulates a L<Test::TAP::Model>'s structure and a
-freeform report text.  If not provided, Test::TAP::HTMLMatrix will
-be used to generate the report.
-
-    use Test::Chimps::Report;
-    use Test::TAP::Model::Visual;
-
-    chdir "some/module/directory";
-
-    my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t"));
-
-    my $report = Test::Chimps::Report->new(model => $model);
-
-    ...
+FIXME
 
 =head1 METHODS
 
 =head2 new ARGS
 
-Creates a new Report.  ARGS is a hash whose valid keys are:
+Creates a new Report.  ARGS is a hash whose only valid key is
+handle.  Its value must be a Jifty::DBI::Handle.
+
+=head1 COLUMNS
+
+C<Test::Chimps::Report>s have the following columns (and consequently accessors):
 
 =over 4
 
-=item * model
+=item * report_html
+
+=item * model_structure
 
-Mandatory and must be an instance of C<Test::Tap::Model>.
+=item * total_ok
 
-=item * report_text
+=item * total_failed
 
-A free-form report.  If not supplied, it is filled in using
-C<Test::TAP::HTMLMatrix>, and C<extra_data> will be passed as the
-C<extra> argument to its constructor.  Note that if you are using
-this class in conjunction with C<Test::Chimps::Server>,
-C<report_text> should probably be HTML.
+=item * total_todo
 
-=item * report_variables
+=item * total_skipped
 
-Report variables to be transmitted with the report.  The decision
-of which variables should be submitted is made by the server.
+=item * total_unexpectedly_succeeded
 
 =back
 
 =cut
 
-use base qw/Class::Accessor/;
+use base qw/Jifty::DBI::Record/;
 
-__PACKAGE__->mk_ro_accessors(
-  qw/model_structure
-    report_text report_variables/
-);
-
-
-sub new {
-  my $class = shift;
-  my $obj = bless {}, $class;
-  $obj->_init(@_);
-  return $obj;
-}
-
-sub _init {
-  my $self = shift;
-  validate_with(
-    params => \@_,
-    called => 'The Test::Chimps::Report constructor',
-    spec   => {
-      model            => { isa => 'Test::TAP::Model' },
-      report_text      => 0,
-      report_variables => {
-        optional => 1,
-        type     => HASHREF
-      }
-    }
-  );
-
-  my %args = @_;
-
-  $self->{model_structure} = $args{model}->structure;
-  if (defined $args{report_text}) {
-    $self->{report_text} = $args{report_text};
-  } else {
-    my $v;
-    if (defined $args{report_variables}) {
-      $v = Test::TAP::HTMLMatrix->new($args{model},
-                                      Dump($args{report_variables}));
-      $self->{report_variables} = $args{report_variables};
-    } else {
-      $v = Test::TAP::HTMLMatrix->new($args{model});
-      $self->{report_variables} = '';
-    }
-    $v->has_inline_css(1);
-    $self->{report_text} = $v->detail_html;
-  }
-}
+package Test::Chimps::Report::Schema;
 
-=head1 ACCESSORS
+use Jifty::DBI::Schema;
 
-There are read-only accessors for model_structure, report_text, and
-report_variables.
+column report_html                  => type is 'text';
+column model_structure              => type is 'text',
+  filters are 'Jifty::DBI::Filter::Storable', 'Jifty::DBI::Filter::base64';
+column timestamp                    => type is 'date',
+  filters are 'Jifty::DBI::Filter::DateTime';
+column total_ok                     => type is 'integer';
+column total_passed                 => type is 'integer';
+column total_nok                    => type is 'integer';
+column total_failed                 => type is 'integer';
+column total_percentage             => type is 'integer';
+column total_ratio                  => type is 'integer';
+column total_seen                   => type is 'integer';
+column total_skipped                => type is 'integer';
+column total_todo                   => type is 'integer';
+column total_unexpectedly_succeeded => type is 'integer';
 
 =head1 AUTHOR
 

Added: Test-Chimps/trunk/lib/Test/Chimps/ReportCollection.pm
==============================================================================
--- (empty file)
+++ Test-Chimps/trunk/lib/Test/Chimps/ReportCollection.pm	Fri Jul  7 15:12:56 2006
@@ -0,0 +1,12 @@
+package Test::Chimps::ReportCollection;
+
+use warnings;
+use strict;
+
+use base qw/Jifty::DBI::Collection/;
+
+sub record_class {
+  return 'Test::Chimps::Report';
+}
+
+1;

Modified: Test-Chimps/trunk/lib/Test/Chimps/Server.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Chimps/Server.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Chimps/Server.pm	Fri Jul  7 15:12:56 2006
@@ -3,6 +3,7 @@
 use warnings;
 use strict;
 
+use Test::Chimps::ReportCollection;
 use Test::Chimps::Report;
 use Test::Chimps::Server::Lister;
 
@@ -10,14 +11,19 @@
 use CGI::Carp   qw<fatalsToBrowser>;
 use CGI;
 use Digest::MD5 qw<md5_hex>;
+use Fcntl       qw<:DEFAULT :flock>;
 use File::Basename;
 use File::Spec;
-use Fcntl       qw<:DEFAULT :flock>;
+use Jifty::DBI::Handle;
+use Jifty::DBI::SchemaGenerator;
 use Params::Validate qw<:all>;
-use Storable    qw<store_fd fd_retrieve freeze>;
+use Storable    qw<store_fd fd_retrieve nfreeze thaw>;
+use Test::TAP::HTMLMatrix;
+use Test::TAP::Model::Visual;
 use YAML::Syck;
+use DateTime;
 
-use constant PROTO_VERSION => 0.1;
+use constant PROTO_VERSION => 0.2;
 
 =head1 NAME
 
@@ -115,7 +121,7 @@
   qw/base_dir bucket_file max_rate max_size
     max_reports_per_subcategory report_dir
     template_dir list_template lister
-    variables_validation_spec/
+    variables_validation_spec handle/
 );
 
 sub new {
@@ -202,6 +208,33 @@
   foreach my $key (keys %args) {
     $self->{$key} = $args{$key};
   }
+
+  if (defined $self->variables_validation_spec) {
+    foreach my $var (keys %{$self->variables_validation_spec}) {
+      package Test::Chimps::Report::Schema;
+      column($var, type(is('text')));
+    }
+  }
+
+  my $dbname = File::Spec->catfile($self->base_dir, 'database');
+  $self->{handle} = Jifty::DBI::Handle->new();
+
+  # create the table if the db doesn't exist.  ripped out of
+  # Jifty::Script::Schema because this stuff should be in
+  # Jifty::DBI, but isn't
+  if (! -e $dbname) {
+    my $sg = Jifty::DBI::SchemaGenerator->new($self->handle);
+    $sg->add_model(Test::Chimps::Report->new(handle => $self->handle));
+  
+    $self->handle->connect(driver => 'SQLite',
+                           database => $dbname);
+    # for non SQLite
+#    $self->handle->simple_query('CREATE DATABASE database');
+    $self->handle->simple_query($_) for $sg->create_table_sql_statements;
+  } else {
+    $self->handle->connect(driver => 'SQLite',
+                           database => $dbname);
+  }
 }
 
 =head2 handle_request
@@ -280,8 +313,8 @@
     exit;
   }
 
-  if(! $cgi->param("reports")) {
-    print "No reports given!";
+  if(! $cgi->param("model_structure")) {
+    print "No model structure given!";
     exit;
   }
 
@@ -292,21 +325,17 @@
   my $self = shift;
   my $cgi = shift;
   
-  my @reports = map { Load($_) } $cgi->param("reports");
-  
   if (defined $self->{variables_validation_spec}) {
-    foreach my $report (@reports) {
-      eval {
-        validate(@{[%{$report->{report_variables}}]}, $self->{variables_validation_spec});
-      };
-      if (defined $@ && $@) {
-        # XXX: doesn't dump subroutines because we're using YAML::Syck
-        print "This server accepts specific report variables.  It's validation ",
-          "string looks like this:\n", Dump($self->{variables_validation_spec}),
-          "\nYour extra data looks like this:\n", Dump($report->{report_variables});
-        exit;
-      }
-
+    my $report_variables = thaw($cgi->param('report_variables'));
+    eval {
+      validate(@{[%$report_variables]}, $self->{variables_validation_spec});
+    };
+    if (defined $@ && $@) {
+      # XXX: doesn't dump subroutines because we're using YAML::Syck
+      print "This server accepts specific report variables.  It's validation ",
+        "string looks like this:\n", Dump($self->{variables_validation_spec}),
+          "\nYour report variables look like this:\n", $cgi->param('report_variables');
+      exit;
     }
   }
 }
@@ -315,26 +344,44 @@
   my $self = shift;
   my $cgi = shift;
 
-  my @reports = $cgi->param("reports");
+  my $params = {};
 
-  foreach my $report (@reports) {
-    my $id = md5_hex $report;
+  $params->{timestamp} = DateTime->from_epoch(epoch => time);
+  
+  my $report_variables = thaw($cgi->param('report_variables'));
+  foreach my $var (keys %{$report_variables}) {
+    $params->{$var} = $report_variables->{$var};
+  }
+  
+  my $model = Test::TAP::Model::Visual->new_with_struct(thaw($cgi->param('model_structure')));
 
-    my $report_file = File::Spec->catfile($self->{base_dir},
-                                          $self->{report_dir},
-                                          $id . ".yml");
-    if (-e $report_file) {
-      print  "One of the submitted reports was already submitted!";
-      exit;
-    }
+  foreach my $var (
+    qw/total_ok
+    total_passed
+    total_nok
+    total_failed
+    total_percentage
+    total_ratio
+    total_seen
+    total_skipped
+    total_todo
+    total_unexpectedly_succeeded/
+    )
+  {
 
-    open my $fh, ">", $report_file or
-      croak "Couldn't open \"$report_file\" for writing: $!\n";
-    print $fh $report or
-      croak "Couldn't write to \"$report_file\": $!\n";
-    close $fh or
-      croak "Couldn't close \"$report_file\": $!\n";
+    $params->{$var} = $model->$var;
   }
+
+  $params->{model_structure} = thaw($cgi->param('model_structure'));
+  
+  my $matrix = Test::TAP::HTMLMatrix->new($model,
+                                          Dump(thaw($cgi->param('report_variables'))));
+  $matrix->has_inline_css(1);
+  $params->{report_html} = $matrix->detail_html;
+
+  my $report = Test::Chimps::Report->new(handle => $self->handle);
+
+  $report->create(%$params) or croak "Couldn't add report to database: $!\n";
 }
 
 sub _process_detail {
@@ -345,16 +392,10 @@
   
   my $id = $cgi->param("id");
 
-  unless ($id =~ m/^[a-f0-9]+$/i) {
-    print "Invalid id: $id";
-    exit;
-  }
-
-  my $report = LoadFile(File::Spec->catfile($self->{base_dir},
-                                            $self->{report_dir},
-                                            $id . ".yml"));
-
-  print $report->report_text;
+  my $report = Test::Chimps::Report->new(handle => $self->handle);
+  $report->load($id);
+  
+  print $report->report_html;
 }
 
 sub _process_listing {
@@ -363,17 +404,11 @@
 
   print $cgi->header();
 
-  my @files = glob File::Spec->catfile($self->{base_dir},
-                                       $self->{report_dir},
-                                       "*.yml");
-
-  my @reports = map { LoadFile($_) } @files;
-
-  # XXX FIXME we shouldn't just be adding this stuff here
-  for (my $i = 0; $i < scalar @reports ; $i++) {
-    my ($filename, $directories, $suffix) = fileparse($files[$i], '.yml');
-    $reports[$i]->{url} = $cgi->url . "?id=$filename";
-    $reports[$i]->{id} = $filename;
+  my $report_coll = Test::Chimps::ReportCollection->new(handle => $self->handle);
+  $report_coll->unlimit;
+  my @reports;
+  while (my $report = $report_coll->next) {
+    push @reports, $report;
   }
 
   my $lister;
@@ -388,7 +423,8 @@
   
   $lister->output_list(File::Spec->catdir($self->{base_dir},
                                           $self->{template_dir}),
-                       \@reports);
+                       \@reports,
+                       $cgi);
                                                    
 }
 

Modified: Test-Chimps/trunk/lib/Test/Chimps/Server/Lister.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Chimps/Server/Lister.pm	(original)
+++ Test-Chimps/trunk/lib/Test/Chimps/Server/Lister.pm	Fri Jul  7 15:12:56 2006
@@ -7,7 +7,6 @@
 use Test::Chimps::Report;
 use HTML::Mason;
 use DateTime;
-use Date::Parse;
 
 =head1 NAME
 
@@ -88,7 +87,7 @@
 }
 
 sub output_list {
-  my ($self, $template_dir, $reports) = @_;
+  my ($self, $template_dir, $reports, $cgi) = @_;
 
   my $interp = HTML::Mason::Interp->new(comp_root => $template_dir);
 
@@ -96,7 +95,8 @@
 
   $interp->exec(File::Spec->catfile(File::Spec->rootdir,
                                     $self->list_template),
-                categories => $categories);
+                categories => $categories,
+                cgi => $cgi);
 }
 
 sub _build_heirarchy {
@@ -117,7 +117,7 @@
 sub _compute_category {
   my $self = shift;
   my $report = shift;
-  return $report->report_variables->{project};
+  return $report->project;
 }
 
 sub _compute_subcategory {
@@ -139,15 +139,13 @@
 }
 
 sub _by_revision_then_date {
-  my $res = $b->report_variables->{revision} <=> $a->report_variables->{revision};
+  my $res = $b->revision <=> $a->revision;
 
   if ($res != 0) {
     return $res;
   }
   
-  my ($adate, $bdate) = (DateTime->from_epoch(epoch => str2time($a->report_variables->{timestamp})),
-                         DateTime->from_epoch(epoch => str2time($b->report_variables->{timestamp})));
-  return DateTime->compare($bdate, $adate);
+  return DateTime->compare($b->timestamp, $a->timestamp);
 }
 
 sub _prune_reports {


More information about the Rt-commit mailing list