XHTML results from the CPAN

Devel-Cover
sub _branch_report {
  my $coverage = shift;
  my $sfmt
    = qq'<table width="100%%"><tr><td class="%s">T</td><td class="%s">F</td></tr></table>';

  return map { {
    percentage => sprintf("%.0f", $_->percentage),
    title  => sprintf("%s/%s", $_->[0][0] ? 'T' : '-', $_->[0][1] ? 'F' : '-'),
    class  => pclass($_->percentage, $_->error),
    string => sprintf($sfmt, bclass($_->[0][0]), bclass($_->[0][1])),
  } }
    @{ $coverage->{branch} }
}
#-------------------------------------------------------------------------------
sub _condition_report {
  my $coverage = shift;
  # use Devel::Cover::Dumper; print STDERR Dumper $coverage;

  my @tables = truth_table(@{ $coverage->{condition} });
  return unless @tables;
  return map { {
    percentage => sprintf("%.0f", $_->[0]->percentage),
    class      => pclass($_->[0]->percentage, $_->[0]->error),
    string     => $_->[0]->html(bclass(0, 1)),
  } } @tables;
}
#-------------------------------------------------------------------------------
sub _time_report {
  my $coverage = shift;
  return map { { string => $_->covered } } @{ $coverage->{time} };
}
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# Subroutine : print_stylesheet()
# Purpose    : Create the stylesheet for HTML reports.
# Notes      :
#-------------------------------------------------------------------------------
sub print_stylesheet {
  my ($db, $options) = @_;
  my $file = "$options->{outputdir}/cover.css";

  open(my $css, '>', $file) or return;
  my $p = tell(DATA);
  print $css <DATA>;
  seek(DATA, $p, 0);
  close($css);
}

#-------------------------------------------------------------------------------
# Subroutine : print_html_header
# Purpose    :
# Notes      :
#-------------------------------------------------------------------------------
sub print_html_header {
  my $fh    = shift;
  my $title = shift;

  print $fh <<"END_HTML";
<!DOCTYPE html
     PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "https://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="https://www.w3.org/1999/xhtml">
<!--
This file was generated by Devel::Cover Version $VERSION
Devel::Cover is copyright 2001-2026, Paul Johnson (paul\@pjcj.net)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
https://pjcj.net
-->
<head>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
    <meta http-equiv="Content-Language" content="en-us"></meta>
    <link rel="stylesheet" type="text/css" href="cover.css"></link>
    <link rel="stylesheet" type="text/css" href="cover.css"></link>
    <title>$title</title>
</head>
END_HTML

}

#-------------------------------------------------------------------------------
# Subroutine : print_summary
# Purpose    :
# Notes      :
#-------------------------------------------------------------------------------
sub print_summary {

  my $fh      = shift;
  my $title   = shift;
  my $file    = shift;
  my $percent = sprintf("%.1f", shift @_ || 0);
  my $error   = shift;
  my $db      = shift;
  my $class   = pclass($percent, $error);

  my $meta = $db->{meta}{$file};

  print $fh <<"END_HTML";
<body>
<h1>$title</h1>
<table>
<tr><td class="h" align="right">File:</td><td align="left">$file</td></tr>
<tr><td class="h" align="right">Coverage:</td><td align="left" class="$class">$percent\%</td></tr>
</table>
<div><br/></div>
<table>
END_HTML

}

#-------------------------------------------------------------------------------
# Subroutine : print_th
# Purpose    :
# Notes      :
#-------------------------------------------------------------------------------
sub print_th {
  my ($fh, $th, $span) = @_;
  print $fh '<tr>';
  foreach my $h (@$th) {
    print $fh $span->{$h}
( run in 3.448 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )