lib/Parrot/Harness/Smoke.pm

   1 # Copyright (C) 2006-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 Parrot::Harness::Smoke - Subroutines used by F<t/harness> to generate smoke reports
   7
   8 =head1 DESCRIPTION
   9
  10 This package exports on request subroutines used by F<t/harness> to generate
  11 smoke reports.
  12
  13 Currently, only one such subroutine is supported:
  14
  15     generate_html_smoke_report (
  16         tests       => \@tests,
  17         args        => $args,
  18         file        => 'smoke.html',
  19     );
  20
  21 =cut
  22
  23 package Parrot::Harness::Smoke;
  24
  25 use strict;
  26 use warnings;
  27
  28 use lib qw( . lib ../lib ../../lib );
  29 use Parrot::Config qw/%PConfig/;
  30 use base qw( Exporter );
  31 our @EXPORT_OK = qw(
  32     generate_html_smoke_report
  33     send_archive_to_smolder
  34 );
  35
  36 my %SMOLDER_CONFIG = (
  37     server     => 'http://smolder.plusthree.com',
  38     username   => 'parrot-autobot',
  39     password   => 'squ@wk',
  40     project_id => 8,
  41 );
  42
  43 sub send_archive_to_smolder {
  44     eval { require LWP::UserAgent };
  45     if( $@ ) {
  46         die "\n" . ('-' x 55) . "\nCould not load LWP::UserAgent."
  47             . "\nPlease install it if you want to send TAP archives smolder.\n"
  48             . ('-' x 55) . "\n\n$@\n";
  49     }
  50
  51     # get the comments from svn
  52     my @lines = grep { $_ =~ /URL|Revision|LastChanged/ } `svn info`;
  53     push @lines, `$^X -v | grep -i 'this is perl'`;
  54     chomp @lines;
  55     my $comments = join("\n", @lines);
  56
  57     my $url = "$SMOLDER_CONFIG{server}/app/developer_projects/process_add_report/$SMOLDER_CONFIG{project_id}";
  58     my $ua = LWP::UserAgent->new();
  59     my $response = $ua->post(
  60         $url,
  61         Content_Type => 'form-data',
  62         Content      => [
  63             architecture => $PConfig{cpuarch},
  64             platform     => $PConfig{osname},
  65             comments     => $comments,
  66             username     => $SMOLDER_CONFIG{username},
  67             password     => $SMOLDER_CONFIG{password},
  68             report_file  => ['parrot_test_run.tar.gz'],
  69         ]
  70     );
  71
  72     if ($response->code != 302) {
  73         die "Could not upload report to Smolder at $SMOLDER_CONFIG{server}"
  74             . "\nHTTP CODE: " . $response->code . " ("
  75             .  $response->message . ")\n";
  76     }
  77 }
  78
  79 sub generate_html_smoke_report {
  80     my $argsref = shift;
  81     my $html_fn = $argsref->{file};
  82     my @smoke_config_vars = qw(
  83         osname archname cc build_dir cpuarch revision VERSION optimize DEVEL
  84     );
  85
  86     eval {
  87         require Test::TAP::HTMLMatrix;
  88         require Test::TAP::Model::Visual;
  89     };
  90     die "You must have Test::TAP::HTMLMatrix installed.\n\n$@"
  91         if $@;
  92
  93     {
  94       no warnings qw/redefine once/;
  95       *Test::TAP::Model::run_tests = sub {
  96         my $self = shift;
  97
  98         $self->_init;
  99         $self->{meat}{start_time} = time();
 100
 101         my %stats;
 102
 103         foreach my $file (@_) {
 104             my $data;
 105             print STDERR "- $file\n";
 106             $data = $self->run_test($file);
 107             $stats{tests} += $data->{results}{max} || 0;
 108             $stats{ok}    += $data->{results}{ok}  || 0;
 109         }
 110
 111         printf STDERR "%s OK from %s tests (%.2f%% ok)\n\n",
 112             $stats{ok},
 113             $stats{tests},
 114             $stats{ok} / $stats{tests} * 100;
 115
 116         $self->{meat}{end_time} = time();
 117       };
 118
 119       my $start = time();
 120       my $model = Test::TAP::Model::Visual->new();
 121       $model->run_tests( @{ $argsref->{tests} } );
 122
 123       my $end = time();
 124
 125       my $duration = $end - $start;
 126
 127       my $v = Test::TAP::HTMLMatrix->new(
 128         $model,
 129         join("\n",
 130              "duration: $duration",
 131              "branch: unknown",
 132              "harness_args: " . (($argsref->{args}) ? $argsref->{args} : "N/A"),
 133              map { "$_: $PConfig{$_}" } sort @smoke_config_vars),
 134       );
 135
 136       $v->has_inline_css(1); # no separate css file
 137
 138       open my $HTML, '>', $html_fn;
 139       print {$HTML} $v->html();
 140       close $HTML;
 141
 142       print "$html_fn has been generated.\n";
 143     }
 144 }
 145
 146 1;
 147
 148 # Local Variables:
 149 #   mode: cperl
 150 #   cperl-indent-level: 4
 151 #   fill-column: 100
 152 # End:
 153 # vim: expandtab shiftwidth=4: