[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} %> sec</td>
- <td class="leftsep num"><% sprintf("%.2f", $model->total_ratio * 100) %>% 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 %>">»</span></td>
- <td><a style="text-decoration: none" href="<% $report->{url} %>" title="Full smoke report">»</a></td>
+ <td class="leftsep"><% $report->committer %></td>
+ <td class="leftsep"><% $report->timestamp %></td>
+ <td class="leftsep num"><% $report->duration %> sec</td>
+ <td class="leftsep num"><% sprintf("%.2f", $report->total_ratio * 100) %>% 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 %>">»</span></td>
+ <td><a style="text-decoration: none" href="<% detail_url($cgi, $report) %>" title="Full smoke report">»</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