qa/test_output_webifier.pl

   1 #!/usr/bin/perl
   2
   3 my $state = 'skipping';
   4 my $error_count = 0;
   5 my $subpage_count = 0;
   6
   7 open  MAIN_PAGE, ">test.html";
   8 print MAIN_PAGE html_header('Test Output Summary');
   9 print MAIN_PAGE qq^<a href="$ARGV[0]">Raw Output</a>\n^;
  10 print MAIN_PAGE "<h1>Test Output Summary</h1>\n";
  11 print MAIN_PAGE 'HTML generated on ' . `date` . "\n";
  12 print MAIN_PAGE "<ul>\n";
  13
  14 open PASS_FAIL, ">pass_fail.txt";
  15
  16 while (my $line = <>) {
  17     if ($line =~ /_\.-~= (.*)$/) {
  18         $state = 'outputting';
  19         print_pass_or_fail();
  20         $error_count = 0;
  21         $subpage_count++;
  22         print MAIN_PAGE qq^\n<li><a href="test.$subpage_count.html">$1</a>^;
  23         open  SUB_PAGE, ">test.$subpage_count.html";
  24         print SUB_PAGE html_header($1);
  25         print SUB_PAGE "<h1>$1</h1>\n<pre>";
  26     }
  27     if ($state eq 'outputting') {
  28         my $class = 'output ';
  29         if ($line =~ /^ok/
  30             || $line =~ /\. ok/
  31             || $line =~ /^PASS/
  32             || $line =~ /\* OK/
  33             || $line =~ /\* Jabber successfully connected/
  34             || $line =~ /\* Database has the expected server encoding /
  35         ) {
  36             $class .= 'ok ';
  37         }
  38         $class .= 'error ' if ($line =~ /^err/i);
  39         if (($line =~ /^not ok/ && !($line =~ /TODO/))
  40             || $line =~ /\. not ok/
  41             || $line =~ /\* ERROR/
  42             || $line =~ /\* WARNING/
  43         ) {
  44             $class .= 'notok ';
  45             $error_count++;
  46         }
  47         if ($line =~ /^not ok/ && $line =~ /TODO/) {
  48             $class .= 'todo ';
  49         }
  50         $class .= 'result ' if ($line =~ /^Result:/);
  51         $class .= 'pass ' if ($line =~ /^Result: PASS/);
  52         if ($line =~ /^Result: FAIL/) {
  53             $class .= 'fail ';
  54             $error_count++;
  55         }
  56         if ($line =~ /^#/
  57             || $line =~ /Checks:/
  58             || $line =~ /_\.-~=/
  59             || $line =~ /=~-\._/
  60             || $line =~ / tests /
  61             || $line =~ /Failed /
  62             || $line =~ /Passed /
  63             || $line =~ /Files=/
  64         ) {
  65             $class .= 'comment ';
  66         }
  67         chomp $line;
  68         my $html_line = "<span class='$class'>$line</span>";
  69         print SUB_PAGE "$html_line\n";
  70     }
  71     if ($line =~ /=~-\._/) {
  72         print SUB_PAGE "</pre>\n" . html_footer();
  73         close SUB_PAGE;
  74         $state = 'skipping';
  75     }
  76 }
  77 print_pass_or_fail();
  78 print MAIN_PAGE html_footer();
  79 close MAIN_PAGE;
  80 close PASS_FAIL;
  81 update_rss();
  82
  83 sub html_header {
  84     my $title = shift;
  85     return qq^
  86 <html>
  87     <head>
  88         <title>$title</title>
  89         <link rel="stylesheet" type="text/css" href="test_output.css">
  90     </head>
  91     <body>
  92     ^;
  93 }
  94
  95 sub html_footer {
  96     return q^
  97     </body>
  98 </html>^;
  99 }
 100
 101 sub print_pass_or_fail {
 102     if ($error_count) {
 103         print MAIN_PAGE ' - <span class="fail">Failed</span>';
 104         print PASS_FAIL "Failed\n";
 105     } else {
 106         if ($subpage_count) {
 107             print MAIN_PAGE ' - <span class="pass">Passed</span>';
 108             print PASS_FAIL "Passed\n";
 109         }
 110     }
 111 }
 112
 113 sub update_rss {
 114     `touch pass_fail.txt.prev`;
 115     if (`diff pass_fail.txt pass_fail.txt.prev`) {
 116         $fail = `grep Failed pass_fail.txt`;
 117         open RSS_FILE, ">test_rss.xml";
 118         print RSS_FILE q^<?xml version="1.0"?>
 119 <rss version="2.0">
 120     <channel>
 121         <title>Test Output Summary</title>
 122         <link>http://testing.evergreen-ils.org/~live/test.html</link>
 123         <description>Live Test Suite</description>
 124         <item>^ . (
 125             $fail
 126             ? q^<title>Test Failure - http://testing.evergreen-ils.org/~live/test.html</title>
 127                 <link>http://testing.evergreen-ils.org/~live/test.html</link>
 128                 <description>One or more tests failed</description>
 129                 ^
 130             : q^<title>Test Success - http://testing.evergreen-ils.org/~live/test.html</title>
 131                 <link>http://testing.evergreen-ils.org/~live/test.html</link>
 132                 <description>All tests passed</description>
 133                 ^
 134         ) . q^</item>
 135     </channel>
 136 </rss>
 137 ^;
 138         close RSS_FILE;
 139     }
 140     `mv pass_fail.txt pass_fail.txt.prev`;
 141 }