github.com/hanks177/podman/v4@v4.1.3-0.20220613032544-16d90015bc83/contrib/cirrus/logformatter (about)

     1  #!/usr/bin/perl
     2  #
     3  # logformatter - highlight a Cirrus test log (ginkgo or bats)
     4  #
     5  # Adapted from https://raw.githubusercontent.com/edsantiago/greasemonkey/podman-ginkgo-highlight
     6  #
     7  package LibPod::CI::LogFormatter;
     8  
     9  use v5.14;
    10  use utf8;
    11  
    12  # Grumble. CI system doesn't have 'open'
    13  binmode STDIN,  ':utf8';
    14  binmode STDOUT, ':utf8';
    15  
    16  use strict;
    17  use warnings;
    18  
    19  (our $ME = $0) =~ s|.*/||;
    20  
    21  our $VERSION = '0.1';
    22  
    23  # Autoflush stdout
    24  $| = 1;
    25  
    26  # For debugging, show data structures using DumpTree($var)
    27  #use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;
    28  
    29  ###############################################################################
    30  # BEGIN user-customizable section
    31  
    32  # Stylesheet for highlighting or de-highlighting parts of lines
    33  our $CSS = <<'END_CSS';
    34  /* wrap long lines - don't require user to scroll right */
    35  pre        { line-break: normal; overflow-wrap: normal; white-space: pre-wrap; }
    36  
    37  /* synopsis table at top */
    38  table.synopsis { border: none; border-collapse: collapse; margin-left: 2em; margin-top: 2ex; }
    39  .synopsis th   { font-weight: normal; font-size: 110%; text-align: right; }
    40  .synopsis td   { font-weight: bold;   font-size: 120%; font-family: monospace; }
    41  
    42  /* test results */
    43  .testname  { font-size: 125%; color: #444; }
    44  .boring    { color: #999; }
    45  .timestamp { color: #999; }
    46  .log-debug { color: #999; }
    47  .log-info  { color: #333; }
    48  .log-warn  { color: #f60; }
    49  .log-error { color: #900; font-weight: bold; }
    50  .log-skip  { color: #F90; }
    51  .log-slow  { background: #FF0; color: #000; font-weight: bold; }
    52  .subtest   { background: #eee; }
    53  .subsubtest { color: #F39; font-weight: bold; }
    54  .string    { color: #00c; }
    55  .command   { font-weight: bold; color: #000; }
    56  .changed   { color: #000; font-weight: bold; }
    57  
    58  /* links to source files: not as prominent as links to errors */
    59  a.codelink:link    { color: #000; }
    60  a.codelink:visited { color: #666; }
    61  a.codelink:hover   { background: #000; color: #999; }
    62  
    63  /* The timing tests at bottom: remove underline, it's too cluttery. */
    64  a.timing           { text-decoration: none; }
    65  .timing:hover      { background: #FF9; }  /* highlight row for easy reading */
    66  
    67  /* BATS styles */
    68  .bats-passed    { color: #393; }
    69  .bats-failed    { color: #F00; font-weight: bold; }
    70  .bats-skipped   { color: #F90; }
    71  .bats-log       { color: #900; }
    72  .bats-log-esm   { color: #b00; font-weight: bold; }
    73  
    74  .bats-summary   { font-size: 150%; }
    75  
    76  /* error titles: display next to timestamp, not on separate line */
    77  h2 { display: inline; }
    78  END_CSS
    79  
    80  # END   user-customizable section
    81  ###############################################################################
    82  
    83  ###############################################################################
    84  # BEGIN boilerplate args checking, usage messages
    85  
    86  sub usage {
    87      print  <<"END_USAGE";
    88  Usage: $ME [OPTIONS] TEST_NAME
    89  
    90  $ME is a filter; it HTMLifies an input stream (presumably
    91  Ginkgo or BATS log results), writing HTML results to an output file
    92  but passing stdin unmodified to stdout. It is intended to run in
    93  the Cirrus CI environment.
    94  
    95  Parameters:
    96  
    97      TEST_NAME   descriptive name; output file will be TEST_NAME.log.html
    98  
    99  OPTIONS:
   100  
   101    --help         display this message
   102    --man          display program man page
   103    --version      display program name and version
   104  END_USAGE
   105  
   106      exit;
   107  }
   108  
   109  # Command-line options.  Note that this operates directly on @ARGV !
   110  our $debug   = 0;
   111  our $force   = 0;
   112  our $verbose = 0;
   113  our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
   114  sub handle_opts {
   115      use Getopt::Long;
   116      GetOptions(
   117          'debug!'     => \$debug,
   118          'dry-run|n!' => sub { $NOT = ' [NOT]' },
   119          'force'      => \$force,
   120          'verbose|v'  => \$verbose,
   121  
   122          help         => \&usage,
   123          version      => sub { print "$ME version $VERSION\n"; exit 0 },
   124      ) or die "Try `$ME --help' for help\n";
   125  }
   126  
   127  # END   boilerplate args checking, usage messages
   128  ###############################################################################
   129  
   130  ############################## CODE BEGINS HERE ###############################
   131  
   132  # The term is "modulino".
   133  __PACKAGE__->main()                                     unless caller();
   134  
   135  # Main code.
   136  sub main {
   137      # Note that we operate directly on @ARGV, not on function parameters.
   138      # This is deliberate: it's because Getopt::Long only operates on @ARGV
   139      # and there's no clean way to make it use @_.
   140      handle_opts();                      # will set package globals
   141  
   142      # In case someone is tempted to run us on the command line
   143      die "$ME: this is a filter, not an interactive script\n" if -t *STDIN;
   144  
   145      # Fetch command-line arguments.  Barf if too many.
   146      my $test_name = shift(@ARGV)
   147          or die "$ME: missing TEST_NAME argument; try $ME --help\n";
   148      warn "$ME: Too many arguments; ignoring extras. try $ME --help\n" if @ARGV;
   149  
   150      format_log($test_name);
   151  }
   152  
   153  
   154  sub format_log {
   155      my $test_name = shift;              # in: e.g. 'integration_test'
   156  
   157      my $outfile = "$test_name.log.html";
   158      my $out_tmp = "$outfile.tmp.$$";
   159      open my $out_fh, '>:utf8', $out_tmp
   160          or warn "$ME: Cannot create $out_tmp: $!\n";
   161  
   162      # Boilerplate: HTML headers for output file
   163      print { $out_fh } <<"END_HTML"      if $out_fh;
   164  <?xml version="1.0" encoding="utf-8"?>
   165  <!DOCTYPE html
   166          PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
   167           "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
   168  <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
   169  <head>
   170  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
   171  <title>$test_name</title>
   172  <style type="text/css">
   173  $CSS
   174  </style>
   175  
   176  <!-- on page load, go to bottom: that's where the error summary is -->
   177  <script language="javascript">
   178  function scrollToBottom() {
   179      if (window.scrollY < 10) {
   180          window.scrollTo(0, document.body.scrollHeight);
   181      }
   182  }
   183  window.addEventListener("load", scrollToBottom, false);
   184  </script>
   185  </head>
   186  <body>
   187  END_HTML
   188  
   189      # Synopsis of this job: show job environment, links to PR and Cirrus
   190      print { $out_fh } "<h2>Synopsis</h2>\n<hr/>\n",
   191          job_synopsis($test_name), "<hr/>\n";
   192  
   193      # State variables
   194      my $previous_timestamp = '';  # timestamp of previous line
   195      my $cirrus_task;              # Cirrus task number, used for linking
   196      my $git_commit;               # git SHA, used for linking to source files
   197      my $in_failure;               # binary flag: are we in an error dump?
   198      my $in_timing;                # binary flag: are we in the timing section?
   199      my $after_divider = 0;        # Count of lines after seeing '-----'
   200      my $current_output;           # for removing duplication
   201      my $looks_like_bats;          # binary flag: for detecting BATS results
   202      my $looks_like_python;        #   " "   "  : for colorizing python tests
   203      my %bats_count;               # For summary line: count of pass/fail/skip
   204  
   205      # When running in cirrus, we have the commit SHA
   206      $git_commit = $ENV{CIRRUS_CHANGE_IN_REPO};
   207  
   208      print { $out_fh } "<pre> <!-- begin processed output -->\n";
   209  
   210      # Assume rootful prompt, check for rootless (here and in log itself, below)
   211      my $Prompt = '#';
   212      $Prompt = '$' if $test_name =~ /rootless/;
   213  
   214      # Main loop: read input, one line at a time, and write out reformatted
   215    LINE:
   216      while (my $line = <STDIN>) {
   217          print $line;                    # Immediately dump back to stdout
   218  
   219          $Prompt = '$' if $line =~ /Runner executing .* as rootless /;
   220  
   221          # Remain robust in face of errors: always write stdout even if no HTML
   222          next LINE if ! $out_fh;
   223  
   224          chomp $line;
   225          $line =~ s/\0//g;               # Some log files have NULs????
   226          $line = escapeHTML($line);
   227  
   228          # Temporarily strip off leading timestamp
   229          $line =~ s/^(\[\+\d+s\]\s)//;
   230          my $timestamp = $1 || '';
   231          if ($previous_timestamp && $timestamp eq $previous_timestamp) {
   232              $timestamp = ' ' x length($timestamp);
   233          }
   234          elsif ($timestamp) {
   235              $previous_timestamp = $timestamp;
   236          }
   237  
   238          # Try to identify the git commit we're working with...
   239          if ($line =~ m!/define.gitCommit=([0-9a-f]+)!) {
   240              $git_commit = $1;
   241          }
   242          # ...so we can link to specific lines in source files
   243          if ($git_commit) {
   244              #           1  12  3                 34     4 5   526  6
   245              $line =~ s{^(.*)(\/(containers\/[^/]+)(\/\S+):(\d+))(.*)$}
   246                        {$1<a class="codelink" href='https://github.com/$3/blob/$git_commit$4#L$5'>$2</a>$6};
   247  
   248              # Same, for python errors
   249              #           1  12  3                 34         4             5   526
   250              $line =~ s{^(.*)(\/(containers\/[^/]+)(\/\S+\.py).*,\s+line\s+(\d+))(,\s+in.*)$}
   251                        {$1<a class="codelink" href='https://github.com/$3/blob/$git_commit$4#L$5'>$2</a>$6};
   252          }
   253  
   254          # Try to identify the cirrus task
   255          if ($line =~ /cirrus-task-(\d+)/) {
   256              $cirrus_task = $1;
   257          }
   258  
   259          # BATS handling. This will recognize num_tests both at start and end
   260          if ($line =~ /^1\.\.(\d+)$/) {
   261              $looks_like_bats = 1;
   262              $bats_count{expected_total} = $1;
   263              undef $looks_like_python;
   264          }
   265          # Since the number of tests can't always be predicted, recognize
   266          # some leading text strings that indicate BATS output to come.
   267          elsif ($line =~ /^TAP\s+version\s/ || $line =~ m!/test-apiv2!) {
   268              $looks_like_bats = 1;
   269              $bats_count{expected_total} = -1; # Expect to be overridden at end!
   270              undef $looks_like_python;
   271          }
   272  
   273          # 'python -m unittest' means we're starting some pythony stuff
   274          elsif ($line =~ m!/python.*\sunittest\s!) {
   275              $looks_like_python = 1;
   276              undef $looks_like_bats;
   277          }
   278          elsif ($looks_like_python && $line =~ m!Ran\s+(\d+)\s+tests\s+in\s!) {
   279              # End of python tests. However, we're still likely to see a
   280              # summary line saying 'OK' or 'FAILED'. Deal with that by
   281              # resetting $looks_like_python to 0, which the next elsif catches
   282              $bats_count{expected_total} += $1;
   283              $looks_like_python = 0;
   284              print { $out_fh } "</div>\n"            if $in_failure;
   285              undef $in_failure;
   286          }
   287          elsif (defined($looks_like_python) && !$looks_like_python) {
   288              # The final python summary line. Show it in its appropriate color.
   289              if ($line =~ /^\s*(OK|FAILED)\s+\(/) {
   290                  undef $looks_like_python;
   291                  my $css = ($1 eq 'OK' ? 'passed' : 'failed');
   292                  print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   293                      if $timestamp;
   294                  print { $out_fh } "<span class='bats-$css'>", $line, "</span>\n";
   295                  next LINE;
   296              }
   297          }
   298  
   299          if ($looks_like_bats) {
   300              my $css;
   301  
   302              # Readability: /long/path/to/podman -> podman (hover for full path)
   303              # Also make it boldface, to make commands stand out
   304              $line =~ s{^(#\s+(#|\$)\s+)(\S+/)(podman\S*)(\s.*)}
   305                        {$1<b><span title="$3$4">$4</span>$5</b>};
   306  
   307              if    ($line =~ /^ok\s.*\s# skip/) { $css = 'skipped' }
   308              elsif ($line =~ /^ok\s/)           { $css = 'passed'  }
   309              elsif ($line =~ /^not\s+ok\s/)     { $css = 'failed'  }
   310              elsif ($line =~ /^#\s#\|\s/)       { $css = 'log-esm' }
   311              elsif ($line =~ /^#\s/)            { $css = 'log'     }
   312  
   313              # Link to source file. This is ugly: we have to hardcode 'podman'
   314              # and 'test/system' because there's no way to get them from log.
   315              #
   316              #          1  2      2               13     4         43           5
   317              $line =~ s{(in(\stest)?\s+file\s+\S+/)(\S+\.(bats|bash)),\s+line\s+(\d+)}{$1<a class="codelink" href="https://github.com/containers/podman/blob/$git_commit/test/system/$3#L$5">$3, line $5</a>};
   318  
   319              if ($css) {
   320                  # Make it linkable, e.g. foo.html#t--00001
   321                  if ($line =~ /^(not\s+)?ok\s+(\d+)\s+(.*)/) {
   322                      $line = sprintf("<a name='t--%05d'>%s</a>", $2, $line);
   323  
   324                      push @{$bats_count{__fail_list}}, [ $2, $3 ] if $1;
   325                  }
   326                  $line = "<span class='bats-$css'>$line</span>";
   327  
   328                  $bats_count{$css}++;
   329              }
   330  
   331              print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   332                  if $timestamp;
   333              print { $out_fh } $line, "\n";
   334              next LINE;
   335          }
   336          elsif ($looks_like_python) {
   337              my $css;
   338  
   339              if    ($line =~ /\s\.\.\.\sskipped/) { $css = 'skipped' }
   340              elsif ($line =~ /\s\.\.\.\sok\s*$/)  { $css = 'passed'  }
   341              elsif ($line =~ /\s\.\.\.\sFAIL/)    { $css = 'failed'  }
   342              elsif ($line =~ /^\s*={40}/)         {
   343                  # Begins a block of multiple lines including a stack trace
   344                  print { $out_fh } "<div class='log-error'>\n" unless $in_failure;
   345                  $in_failure = 1;
   346              }
   347  
   348              if ($css) {
   349                  $line = "<span class='bats-$css'>$line</span>";
   350  
   351                  $bats_count{$css}++;
   352              }
   353              print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   354                  if $timestamp;
   355              print { $out_fh } $line, "\n";
   356              next LINE;
   357          }
   358  
   359          # Timing section at the bottom of the page
   360          if ($line =~ / timing results\s*$/) {
   361              $in_timing = 1;
   362          }
   363          elsif ($in_timing) {
   364              if ($line =~ /^(\S.*\S)\s+(\d+\.\d+)\s*$/) {
   365                  my ($name, $time) = ($1, $2);
   366                  my $id = make_id($1, 'timing');
   367  
   368                  # Try to column-align the timing numbers. Some test names
   369                  # will be longer than our max - oh well.
   370                  my $spaces = 80 - length(unescapeHTML($name));
   371                  $spaces = 1 if $spaces < 1;
   372                  $spaces++ if $time < 10;
   373                  my $spacing = ' ' x $spaces;
   374                  $line = qq{<span class="timing"><a href="#t--$id">$name</a>$spacing$time</span>};
   375              }
   376              else {
   377                  $in_timing = 0;
   378              }
   379          }
   380  
   381          #
   382          # Ginkgo error reformatting
   383          #
   384          if ($line =~ /^.{1,4} (Failure|Panic)( in .*)? \[/) {
   385              # Begins a block of multiple lines including a stack trace
   386              print { $out_fh } "<div class='log-error'>\n";
   387              $in_failure = 1;
   388          }
   389          elsif ($line =~ /^-----------/) {
   390              if ($in_failure) {
   391                  # Ends a stack trace block
   392                  $in_failure = 0;
   393                  print { $out_fh } "</div>\n";
   394              }
   395              $after_divider = 1;
   396  
   397              print { $out_fh } "</pre>\n<hr />\n<pre>\n";
   398              # Always show timestamp at start of each new test
   399              $previous_timestamp = '';
   400              next LINE;
   401          }
   402          # (bindings test sometimes emits 'Running' with leading bullet char)
   403          elsif ($line =~ s!^•?Running:!<span class="boring">$Prompt</span>!) {
   404              # Highlight the important (non-boilerplate) podman command.
   405              $line =~ s/\s+--remote\s+/ /g;      # --remote takes no args
   406              # Strip out the global podman options, but show them on hover
   407              $line =~ s{(\S+\/podman(-remote)?)((\s+--(root|runroot|runtime|tmpdir|storage-opt|conmon|cgroup-manager|network-backend|network-config-dir|storage-driver|events-backend|url) \S+)*)(.*)}{
   408                  my ($full_path, $remote, $options, $args) = ($1, $2||'', $3, $6);
   409  
   410                  $options =~ s/^\s+//;
   411                  # Separate each '--foo bar' with newlines for readability
   412                  $options =~ s/ --/\n--/g;
   413                  qq{<span title="$full_path"><b>podman$remote</b></span> <span class=\"boring\" title=\"$options\">[options]</span><b>$args</b>};
   414              }e;
   415              $current_output = '';
   416          }
   417          # Grrr. 'output:' usually just tells us what we already know.
   418          elsif ($line =~ /^output:/) {
   419              $current_output =~ s!^\s+|\s+$!!g;  # Trim leading/trailing blanks
   420              $current_output =~ s/\s+/ /g;       # Collapse multiple spaces
   421              if ($line eq "output: $current_output" || $line eq 'output: ') {
   422                  next LINE;
   423              }
   424          }
   425          elsif ($line =~ /^Error:/ || $line =~ / level=(warning|error) /) {
   426              $line = "<span class='log-warn'>" . $line . "</span>";
   427          }
   428          elsif ($line =~ /^panic:/) {
   429              $line = "<span class='log-error'>" . $line . "</span>";
   430          }
   431          else {
   432              $current_output .= ' ' . $line;
   433          }
   434  
   435  
   436          # Two lines after each divider, there's a test name. Make it
   437          # an anchor so we can link to it later.
   438          if ($after_divider++ == 2) {
   439              # Sigh. There is no actual marker. Assume that anything with
   440              ## two leading spaces then alpha or hyphen (not slashes) is
   441              ## a test name.
   442              if ($line =~ /^  [a-zA-Z-]/) {
   443                  my $id = make_id($line, 'anchor');
   444  
   445                  $line = "<a name='t--$id'><h2>$line</h2></a>";
   446              }
   447          }
   448  
   449          # Make SKIPPING and SLOW TEST visible
   450          $line =~ s!(\[SKIPPING\].*)!<span class="log-skip">$1</span>!;
   451          $line =~ s!(\[SLOW TEST.*\])!<span class="log-slow">$1</span>!;
   452  
   453          # Highlight test name when it appears in the middle of commands.
   454          # But make it boring, because we already have the test name in large
   455          # bold just above. (Except in skipped tests).
   456          $line =~ s!^(\s*)(\[It\]\s+.*)!$1<span class="testname">$2</span>!;
   457  
   458          # Failure name corresponds to a previously-seen block.
   459          #              1  2           2        3             3   14           4
   460          if ($line =~ /^(\[(Fail|Panic!)\] .* \[(It|BeforeEach)\] )([A-Za-z-].*)/) {
   461              my ($lhs, $type, $ginkgo_fluff, $testname) = ($1, $2, $3, $4);
   462              my $id = make_id($testname, 'link');
   463  
   464              $line = "<b>$lhs<a href='#t--$id'>$testname</a></b>";
   465          }
   466  
   467          print { $out_fh } "<span class=\"timestamp\">$timestamp</span>"
   468              if $timestamp;
   469          print { $out_fh } $line, "\n";
   470      }
   471  
   472      my $have_formatted_log;     # Set on success
   473  
   474      if ($out_fh) {
   475          # Summary line for BATS tests
   476          if (keys %bats_count) {
   477              print { $out_fh } "<hr/><span class='bats-summary'>Summary:";
   478              my $total = 0;
   479              my $comma = '';
   480              for my $class (qw(passed failed skipped)) {
   481                  if (my $n = $bats_count{$class}) {
   482                      printf { $out_fh } "%s <span class='bats-%s'>%d %s</span>",
   483                          $comma, $class, $n, ucfirst($class);
   484                      $total += $n;
   485                      $comma = ',';
   486                  }
   487              }
   488  
   489              printf { $out_fh } ". Total tests: $total";
   490              if (my $expected_total = $bats_count{expected_total}) {
   491                  if ($total != $expected_total) {
   492                      print { $out_fh } " <span class='bats-failed'>(WARNING: expected $expected_total)</span>";
   493                  }
   494              }
   495              print { $out_fh } "</span>\n";
   496          }
   497  
   498          print { $out_fh } "</pre>  <!-- end processed output -->\n";
   499  
   500          # Did we find a cirrus task? Link back.
   501          if ($cirrus_task) {
   502              print { $out_fh } <<"END_HTML";
   503  <hr />
   504  <h3>Cirrus <a href="https://cirrus-ci.com/task/$cirrus_task">task $cirrus_task</a></h3>
   505  END_HTML
   506          }
   507  
   508          # FIXME: need a safe way to get TZ
   509          printf { $out_fh } <<"END_HTML", scalar(CORE::localtime);
   510  <hr />
   511  <small>Processed %s by $ME v$VERSION</small>
   512  </body>
   513  </html>
   514  END_HTML
   515  
   516          if (close $out_fh) {
   517              if (rename $out_tmp => $outfile) {
   518                  $have_formatted_log = 1;
   519              }
   520              else {
   521                  warn "$ME: Could not rename $out_tmp: $!\n";
   522              }
   523          }
   524          else {
   525              warn "$ME: Error writing $out_tmp: $!\n";
   526          }
   527      }
   528  
   529      # Grumble. Github only shows the last N lines of the log... which is
   530      # anti-helpful when you want a quick synopsis of what failed. Write a
   531      # summary at the tail, to make it easier for humans to see what went wrong.
   532      if (my $fails = $bats_count{__fail_list}) {
   533          print  "\n";
   534          printf "Failed tests (%d):\n", scalar(@$fails);
   535          printf " - %d %s\n", @$_ for @$fails;
   536      }
   537  
   538      # If Cirrus magic envariables are available, write a link to results.
   539      # FIXME: it'd be so nice to make this a clickable live link.
   540      #
   541      # STATIC_MAGIC_BLOB is the name of a google-storage bucket. It is
   542      # unlikely to change often, but if it does you will suddenly start
   543      # seeing errors when trying to view formatted logs:
   544      #
   545      #    AccessDeniedAccess denied.Anonymous caller does not have storage.objects.get access to the Google Cloud Storage object.
   546      #
   547      # This happened in July 2020 when github.com/containers/libpod was
   548      # renamed to podman. If something like that ever happens again, you
   549      # will need to get the new magic blob value from:
   550      #
   551      #   https://console.cloud.google.com/storage/browser?project=libpod-218412
   552      #
   553      # You will also probably need to set the bucket Public by clicking on
   554      # the bucket name, then the Permissions tab. This is safe, since this
   555      # project is fully open-source.
   556      if ($have_formatted_log && $ENV{CIRRUS_TASK_ID}) {
   557          my $URL_BASE          = "https://storage.googleapis.com";
   558          my $STATIC_MAGIC_BLOB = "cirrus-ci-6707778565701632-fcae48";
   559          my $ARTIFACT_NAME     = "html";
   560  
   561          my $URL = "${URL_BASE}/${STATIC_MAGIC_BLOB}/artifacts/$ENV{CIRRUS_REPO_FULL_NAME}/$ENV{CIRRUS_TASK_ID}/${ARTIFACT_NAME}/${outfile}";
   562  
   563          print "\n\nAnnotated results:\n  $URL\n";
   564      }
   565  }
   566  
   567  
   568  #############
   569  #  make_id  #  Given a test name, generate an anchor link name
   570  #############
   571  sub make_id {
   572      my $name = shift;                   # in: test title
   573      my $type = shift;                   # in: differentiator (anchor, link)
   574  
   575      state %counter;
   576  
   577      $name =~ s/^\s+|\s+$//g;            # strip leading/trailing whitespace
   578      $name =~ s/\&#\d+;//g;              # 'doesn&#39;t' -> 'doesnt'
   579      $name =~ s/\&quot;/-/g;             # '&quot;path&quot;' -> '-path-'
   580      $name =~ s/[^a-zA-Z0-9_-]/-/g;      # Convert non-alphanumeric to dash
   581      $name =~ s/-{3,}/-/g;               # '------' to just '-'
   582  
   583      # Keep a running tally of how many times we've seen this identifier
   584      # for this given type! This lets us cross-match, in the bottom of
   585      # the page, the first/second/third failure of a given test.
   586      $name .= "--" . ++$counter{$type}{$name};
   587  
   588      $name;
   589  }
   590  
   591  
   592  ###############################################################################
   593  # BEGIN job_synopsis and related helpers
   594  
   595  ##################
   596  #  job_synopsis  #  Job details, links to github/cirrus
   597  ##################
   598  sub job_synopsis {
   599      my $subtest_name = shift;           # e.g. integration_test
   600  
   601      my $s = <<"END_SYNOPSIS";
   602  <table class="synopsis">
   603  END_SYNOPSIS
   604  
   605      # PR 1234 - title of the pr
   606      my $pr_title = escapeHTML(_env_replace("{CIRRUS_CHANGE_TITLE}"));
   607      $s .= _tr("GitHub PR", sprintf("%s - %s",
   608                                     _a("{CIRRUS_PR}", "https://{CIRRUS_REPO_CLONE_HOST}/{CIRRUS_REPO_FULL_NAME}/pull/{CIRRUS_PR}"),
   609                                     $pr_title));
   610  
   611      # PR author, if signed-off-by
   612      if (my $msg = _env_replace("{CIRRUS_COMMIT_MESSAGE}")) {
   613          while ($msg =~ /^Signed-off-by:\s+(\S.*\S)$/gmi) {
   614              $s .= _tr("Author", escapeHTML($1));
   615          }
   616      }
   617  
   618      # eg "test fedora", "special_testing_rootless"
   619      # WARNING: As of 2020-10-05, $CIRRUS_TASK_NAME reflects the same
   620      # descriptive content as our $subtest_name argument (confirm via
   621      # cross-checking runner.sh:logformatter() vs cirrus.yml:&std_name_fmt).
   622      # If this ever becomes untrue, just add _tr("Subtest", $subtest_name).
   623      my $test_name = _env_replace("{CIRRUS_TASK_NAME}");
   624      # (Special-case cleanup: Cirrus\ quotes\ spaces; remove for readability).
   625      $test_name =~ s/\\\s+/ /g;
   626      $s .= _tr("Test name", $test_name);
   627  
   628      # Link to further Cirrus results, e.g. other runs.
   629      # Build is mostly boring, it's usually TASK that we want to see.
   630      $s .= _tr("Cirrus", sprintf("<small>Build %s</small> / <b>Task %s</b>",
   631                                  _a("{CIRRUS_BUILD_ID}", "https://cirrus-ci.com/build/{CIRRUS_BUILD_ID}"),
   632                                  _a("{CIRRUS_TASK_ID}", "https://cirrus-ci.com/task/{CIRRUS_TASK_ID}")));
   633  
   634      $s .= "</table>\n";
   635      return $s;
   636  }
   637  
   638  
   639  sub _tr {
   640      my ($th, $td) = @_;
   641      return "<tr><th>$th:</th><td>$td</td></tr>\n";
   642  }
   643  
   644  sub _a {
   645      my ($name, $href) = map { _env_replace($_) } @_;
   646  
   647      if ($href =~ /UNDEFINED/) {
   648          return "$name ($href)";
   649      }
   650      return "<a href='$href'>$name</a>";
   651  }
   652  
   653  sub _env_replace {
   654      my $s_in = shift;
   655  
   656      $s_in =~ s[\{(.*?)\}][$ENV{$1} || "[$1 UNDEFINED]"]ge;
   657  
   658      return $s_in;
   659  }
   660  
   661  # END   job_synopsis and related helpers
   662  ###############################################################################
   663  # BEGIN html-formatting helpers
   664  
   665  sub escapeHTML {
   666      my $s = shift;
   667  
   668      state %chars;
   669      %chars = ('&' => '&amp;', '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', "'" => '&#39;')
   670          if keys(%chars) == 0;
   671      my $class = join('', sort keys %chars);
   672      $s =~ s/([$class])/$chars{$1}/ge;
   673  
   674      return $s;
   675  }
   676  
   677  sub unescapeHTML {
   678      my $s = shift;
   679  
   680      # We don't actually care about the character, only its length
   681      $s =~ s/\&\#?[a-z0-9]+;/./g;
   682  
   683      return $s;
   684  }
   685  
   686  # END   html-formatting helpers
   687  ###############################################################################
   688  
   689  1;