[Rt-commit] r5424 - 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:32:40 EDT 2006
Author: zev
Date: Fri Jun 23 17:32:39 2006
New Revision: 5424
Modified:
Test-Chimps/ (props changed)
Test-Chimps/trunk/Makefile.PL
Test-Chimps/trunk/bin/receive_report.pl
Test-Chimps/trunk/bin/submit_report.pl
Test-Chimps/trunk/examples/list.tmpl
Test-Chimps/trunk/lib/Test/Smoke/Report.pm
Test-Chimps/trunk/lib/Test/Smoke/Report/Client.pm
Test-Chimps/trunk/lib/Test/Smoke/Report/Server.pm
Log:
r4188 at galvatron (orig r5): zev | 2006-06-20 17:58:28 -0400
r4128 at galvatron: zev | 2006-06-19 02:11:40 -0400
everything works except for compression and deleting old files
Modified: Test-Chimps/trunk/Makefile.PL
==============================================================================
--- Test-Chimps/trunk/Makefile.PL (original)
+++ Test-Chimps/trunk/Makefile.PL Fri Jun 23 17:32:39 2006
@@ -12,8 +12,6 @@
requires('Params::Validate');
requires('Test::TAP::HTMLMatrix');
requires('Test::TAP::Model::Visual');
-requires('Time::Piece');
-requires('Time::Seconds');
requires('YAML::Syck');
Modified: Test-Chimps/trunk/bin/receive_report.pl
==============================================================================
--- Test-Chimps/trunk/bin/receive_report.pl (original)
+++ Test-Chimps/trunk/bin/receive_report.pl Fri Jun 23 17:32:39 2006
@@ -5,49 +5,12 @@
use Test::Smoke::Report::Server;
my $server = Test::Smoke::Report::Server->new(base_dir => '/var/www/bps-smokes',
- validate_extra =>
- { base_dir =>
- { type => SCALAR,
- optional => 0 },
- bucket_file =>
- { type => SCALAR,
- default => 'bucket.dat',
- optional => 1 },
- burst_rate =>
- { type => SCALAR,
- optional => 1,
- default => 5,
- callbacks =>
- { "greater than or equal to 0" =>
- sub { $_[0] >= 0 }} },
- max_rate =>
- { type => SCALAR,
- default => (1 / 30),
- optional => 1,
- callbacks =>
- {"greater than or equal to 0" =>
- sub { $_[0] >= 0 }} },
- max_size =>
- { type => SCALAR,
- default => 2**20 * 3.0,
- optional => 1,
- callbacks =>
- { "greater than or equal to 0" =>
- sub { $_[0] >= 0 }} },
- max_smokes_same_category =>
- { type => SCALAR,
- default => 5,
- optional => 1,
- callbacks =>
- { "greater than or equal to 0" =>
- sub { $_[0] >= 0 }} },
- report_dir =>
- { type => SCALAR,
- default => 'reports',
- optional => 1 },
- validate_extra =>
- { type => HASHREF,
- optional => 1 }});
-
+ extra_validation_spec =>
+ { category => 1,
+ subcategory => 1,
+ project => 1,
+ revision => 1,
+ timestamp => 1,
+ duration => 1 });
$server->handle_request;
Modified: Test-Chimps/trunk/bin/submit_report.pl
==============================================================================
--- Test-Chimps/trunk/bin/submit_report.pl (original)
+++ Test-Chimps/trunk/bin/submit_report.pl Fri Jun 23 17:32:39 2006
@@ -12,9 +12,18 @@
chdir "jifty/trunk";
-my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t"));# t/*/t/*.t"));
-
-my $report = Test::Smoke::Report->new(model => $model);
+my $start_time = time;
+my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t t/*/t/*.t"));
+my $duration = time - $start_time;
+
+my $report = Test::Smoke::Report->new(model => $model,
+ extra_data =>
+ { category => 'Jifty',
+ subcategory => 'repository snapshot / Linux',
+ project => 'jifty',
+ revision => 5,
+ timestamp => scalar gmtime,
+ duration => $duration });
my $client = Test::Smoke::Report::Client->new(reports => [$report],
server => 'http://galvatron.mit.edu/cgi-bin/receive_report.pl');
Modified: Test-Chimps/trunk/examples/list.tmpl
==============================================================================
--- Test-Chimps/trunk/examples/list.tmpl (original)
+++ Test-Chimps/trunk/examples/list.tmpl Fri Jun 23 17:32:39 2006
@@ -77,7 +77,7 @@
% foreach my $subcategory (keys %{$categories{$category}}) {
<tr><th colspan="11" class="subcategory"><% $subcategory %></th></tr>
% foreach my $report (@{$categories{$category}->{$subcategory}}) {
-% my $id = 5;
+% my $id = $report->{id};
% my $data = $report->extra_data;
% my $model = Test::TAP::Model::Visual->new_with_struct($report->model_structure);
<tr>
@@ -86,8 +86,8 @@
r<% $data->{revision} %>
</td>
<td class="leftsep"><% $data->{timestamp} %></td>
- <td class="leftsep num"><% $data->{duration} %></td>
- <td class="leftsep num"><% $model->total_ratio %>> % ok</td>
+ <td class="leftsep num"><% $data->{duration} %> sec</td>
+ <td class="leftsep num"><% $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>
@@ -95,7 +95,7 @@
<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="<tmpl_var name=link>" title="Full smoke report">»</a></td>
+ <td><a style="text-decoration: none" href="<% $report->{url} %>" title="Full smoke report">»</a></td>
</tr>
<tr class="details" id="details_<% $id %>">
<td colspan="11" class="report_details">
@@ -106,7 +106,7 @@
<span class="tests_skipped"><% $model->total_skipped %> skipped</span> and
<span class="tests_unexpect"><% $model->total_unexpectedly_succeeded %> unexpectedly succeeded</span>
<br />
- <a href="<tmpl_var name=link>" title="Full smoke report">View full smoke report</a>
+ <a href="<% $report->{url} %>" title="Full smoke report">View full smoke report</a>
</td>
</tr>
% }
@@ -117,6 +117,7 @@
</html>
<%args>
+$report_dir
@reports
</%args>
@@ -124,6 +125,6 @@
my %categories;
foreach my $report (@reports) {
my $data = $report->extra_data;
- $categories{$data->{category}}->{$data->{subcategory}} = $report;
+ push @{$categories{$data->{category}}->{$data->{subcategory}}}, $report;
}
</%init>
Modified: Test-Chimps/trunk/lib/Test/Smoke/Report.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Smoke/Report.pm (original)
+++ Test-Chimps/trunk/lib/Test/Smoke/Report.pm Fri Jun 23 17:32:39 2006
@@ -93,12 +93,13 @@
my $v;
if (defined $args{extra_data}) {
$v = Test::TAP::HTMLMatrix->new($args{model},
- Dump($args{extra}));
+ Dump($args{extra_data}));
$self->{extra_data} = $args{extra_data};
} else {
$v = Test::TAP::HTMLMatrix->new($args{model});
$self->{extra_data} = '';
- }
+ }
+ $v->has_inline_css(1);
$self->{report_text} = $v->detail_html;
}
}
Modified: Test-Chimps/trunk/lib/Test/Smoke/Report/Client.pm
==============================================================================
--- Test-Chimps/trunk/lib/Test/Smoke/Report/Client.pm (original)
+++ Test-Chimps/trunk/lib/Test/Smoke/Report/Client.pm Fri Jun 23 17:32:39 2006
@@ -153,6 +153,7 @@
my $serialized_reports = [ map { Dump($_) } @{$self->reports} ];
my %request = (upload => 1, version => PROTO_VERSION,
reports => $serialized_reports);
+
my $resp = $ua->post($self->server => \%request);
if($resp->is_success) {
if($resp->content =~ /^ok/) {
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:32:39 2006
@@ -3,17 +3,18 @@
use warnings;
use strict;
+use Test::Smoke::Report;
+
use Algorithm::TokenBucket;
use CGI::Carp qw<fatalsToBrowser>;
use CGI;
use Digest::MD5 qw<md5_hex>;
+use File::Basename;
use File::Spec;
use Fcntl qw<:DEFAULT :flock>;
use HTML::Mason;
use Params::Validate qw<:all>;
use Storable qw<store_fd fd_retrieve freeze>;
-use Time::Piece;
-use Time::Seconds;
use YAML::Syck;
use constant PROTO_VERSION => 0.1;
@@ -63,6 +64,12 @@
Burst upload rate allowed (see L<Algorithm::Bucket>). Defaults to
5.
+=item * extra_validation_spec
+
+A hash reference of the form accepted by Params::Validate. If
+supplied, this will be used to validate the extra data submitted to
+the server.
+
=item * list_template
Template filename under base_dir/template_dir to use for listing
@@ -92,12 +99,6 @@
Directory under base_dir where html templates will be stored.
Defaults to 'templates'.
-=item * validate_extra
-
-A hash reference in the form accepted by Params::Validate. If
-supplied, this will be used to validate the extra data submitted to
-the server.
-
=back
=cut
@@ -106,7 +107,7 @@
no strict 'refs';
our @fields = qw/base_dir bucket_file max_rate max_size
max_smokes_per_subcategory report_dir
- template_dir list_template validate_extra/;
+ template_dir list_template extra_validation_spec/;
foreach my $field (@fields) {
*{$field} =
@@ -144,6 +145,9 @@
callbacks =>
{ "greater than or equal to 0" =>
sub { $_[0] >= 0 }} },
+ extra_validation_spec =>
+ { type => HASHREF,
+ optional => 1 },
list_template =>
{ type => SCALAR,
optional => 1,
@@ -179,9 +183,6 @@
template_dir =>
{ type => SCALAR,
default => 'templates',
- optional => 1 },
- validate_extra =>
- { type => HASHREF,
optional => 1 }
});
@@ -203,6 +204,8 @@
my $cgi = CGI->new;
if ($cgi->param("upload")) {
$self->_process_upload($cgi);
+ } elsif ($cgi->param("id")) {
+ $self->_process_detail($cgi);
} else {
$self->_process_listing($cgi);
}
@@ -305,6 +308,7 @@
my $id = md5_hex $report;
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!";
@@ -324,24 +328,107 @@
# XXX: stub
}
+sub _process_detail {
+ my $self = shift;
+ my $cgi = shift;
+
+ print $cgi->header;
+
+ 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;
+}
+
sub _process_listing {
my $self = shift;
my $cgi = shift;
- print $cgi->header("text/html");
+ print $cgi->header();
+
+ my @files = glob File::Spec->catfile($self->{base_dir},
+ $self->{report_dir},
+ "*.yml");
my @reports = map { bless LoadFile($_), 'Test::Smoke::Report' }
- glob File::Spec->catfile($self->{base_dir},
- $self->{report_dir},
- "*.yml");
+ @files;
+ 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 $interp = HTML::Mason::Interp->new(comp_root =>
File::Spec->catfile($self->{base_dir},
$self->{template_dir}));
- $interp->exec(File::Spec->catfile('/' . $self->{list_template}),
+ $interp->exec(File::Spec->catfile(File::Spec->rootdir,
+ $self->{list_template}),
+ report_dir => $self->{http_report_dir},
reports => \@reports);
}
+=head1 AUTHOR
+
+Zev Benjamin, C<< <zev at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-test-smoke-report at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Smoke-Report>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Test::Smoke::Report
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Test-Smoke-Report>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Test-Smoke-Report>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Smoke-Report>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Test-Smoke-Report>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+The code in this distribution is based on smokeserv-client.pl and
+smokeserv-server.pl from the PUGS distribution.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006 Zev Benjamin, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
1;
More information about the Rt-commit
mailing list