source: status/report.pl @ 1151

Last change on this file since 1151 was 1151, checked in by Earle Martin, 14 years ago

Put time on the horizontal axis at perigrin's request.

File size: 1.5 KB
Line 
1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use Data::Dumper;
7use Template;
8
9my (%results_by_date, %results_by_test);
10
11foreach (glob "reports/*") {
12        my ($report_name) = $_ =~ m{reports/test-results-(.*)\.txt};
13       
14        $results_by_date{$report_name} = load_report($_);
15}
16
17# Turn sorted-by-date structure inside out.
18foreach my $date (keys %results_by_date) {
19                my $date_result = $results_by_date{$date};
20                foreach my $test_name (keys %$date_result) {
21                        $results_by_test{$test_name}{$date} = $date_result->{$test_name};
22                }
23}
24
25my %report_data = (
26        'results'    => \%results_by_test,
27        'test_dates' => [ sort keys %results_by_date ],
28);
29
30my $tt = Template->new({
31        INCLUDE_PATH => 'templates',
32});
33
34$tt->process('tests.tt', { 'data' => \%report_data }) or die $tt->error;
35
36# ----------------------------------------------------------------------------
37
38sub load_report {
39        my $file = shift;
40
41        die 'No input file specified'  unless $file;
42        die "That file doesn't exist"  unless -e $file;
43        die "That isn't a plain file"  unless -f _;
44        die "That file isn't readable" unless -r _;
45
46        open (my $RESULTS, '<', $file) or die "Can't open $file: $!";
47        my @lines = <$RESULTS>;
48        close $RESULTS;
49
50        my (%tests, $current_test);
51
52        # XXX: Test files get added, removed, renamed, etc. A mechanism is necessary
53        # here to cope with this.
54       
55        foreach (@lines) {
56                        chomp;
57
58                        if (m{^t/(.*?)\.}) {
59                                $current_test = $1;
60                        } elsif (/^ok$/) {
61                                $tests{$current_test} = 100;
62                        } elsif (/Failed .*? tests, (.*?)% okay/) {
63                                $tests{$current_test} = $1;
64                        }
65        }
66       
67        \%tests;
68}
Note: See TracBrowser for help on using the repository browser.