view release on metacpan or  search on metacpan

lib/Devel/Cover/Report/Html_minimal.pm  view on Meta::CPAN

<table>
END_HTML
  print_th($fh, [ 'file', @$th, 'total' ]);

  my @files = (grep($db->{summary}{$_}, @{ $options->{file} }), 'Total');

  for my $file (@files) {
    my $summary = get_summary_for_file($db, $file, $show);

    my $url = get_link($file);
    if ($url) {
      print $fh qq'<tr><td align="left"><a href="$url">$file</a></td>';
    } else {
      print $fh qq'<tr><td align="left">$file</td>';
    }

    for my $c (@$show) {
      my $pc = $summary->{$c}{percent};
      my ($class, $popup, $link);

      if ($pc eq 'n/a' || $c eq 'time') {
        $class = $popup = '';
      } else {
        $class = sprintf(qq' class="%s"', pclass($pc, $summary->{$c}{error}));
        $popup = sprintf(qq' title="%s"', $c . ': ' . $summary->{$c}{ratio});
        if ($c =~ /branch|condition|subroutine/) {
          $link = get_link($file, $c);
        }
      }

      if ($link) {
        printf $fh qq'<td%s%s><a href="%s">%s</a></td>', $class, $popup, $link,
          $pc;
      } else {
        printf $fh qq'<td%s%s>%s</td>', $class, $popup, $pc;
      }
    }
    print $fh "</tr>\n";
  }
  print $fh "</table>\n</body>\n</html>\n";
  close($fh) or warn "Unable to close '$outfile' [$!]";

  print "HTML output written to $outfile\n" unless $options->{silent};
}

#-------------------------------------------------------------------------------
# Subroutine : escape_HTML
# Purpose    : make source code web-safe
# Notes      :
#-------------------------------------------------------------------------------
sub escape_HTML {
  my $text = shift;
  chomp $text;

  $text = encode_entities($text);

  # Do not allow FF in text
  $text =~ tr/\x0c//d;

  # IE doesn't honor "white-space: pre" CSS
  my @text = split m/\n/ => $text;
  for (@text) {
    # Expand all tabs to spaces
    1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    # make multiple spaces be multiple spaces
    s/(  +)/'&nbsp;' x length $1/ge;
  }

  return join "\n" => @text;
}

#-------------------------------------------------------------------------------
# Subroutine : print_file_report()
# Purpose    : Print coverage overview report for a file.
# Notes      :
#-------------------------------------------------------------------------------
sub print_file_report {
  my ($db, $fin, $opt) = @_;

  my $fout = "$opt->{outputdir}/$Filenames{$fin}.html";
  open(my $in,  '<', $fin)  or warn("Can't read file '$fin' [$!]\n"),  return;
  open(my $out, '>', $fout) or warn("Can't open file '$fout' [$!]\n"), return;

  my ($show, $th) = get_showing_headers($db, $opt);
  my $file_data = $db->cover->file($fin);

  print_html_header($out, "File Coverage: $fin");
  print_summary(
    $out, 'File Coverage',
    $fin,
    $db->{summary}{$fin}{total}{percentage},
    $db->{summary}{$fin}{total}{error}, $db
  );
  print_th($out, [ 'line', @$th, 'code' ]);

  my $autoloader = 0;
  while (my $sloc = <$in>) {
    $autoloader ||= $sloc =~ /use\s+AutoLoader/;

    # Process stuff after __END__ or __DATA__ tokens
    if (!$autoloader && $sloc =~ /^__(END|DATA)__/) {
      if ($opt->{option}{data}) {
        # print all data in one cell
        my ($i, $n) = ($., scalar @$th);
        while (my $line = <$in>) { $sloc .= $line }
        $sloc = escape_HTML($sloc);
        print $out
          qq'<tr><td class="h">$i - $.</td><td colspan="$n"></td><td class="s"><pre>$sloc</pre></td></tr>\n';
        # &nbsp; is IE empty cell hack
        #print $out qq'<tr><td class="h">$i - $.</td><td colspan="$n">&nbsp;</td><td class="s"><pre>$sloc</pre></td></tr>\n';
      }
      last;
    }

    # Process embedded POD
    if ($sloc =~ /^=(pod|head|over|item|begin|for)/) {
      if ($opt->{option}{pod}) {
        # print all POD in one cell
        my ($i, $n) = ($., scalar @$th);
        while (my $line = <$in>) {
          $sloc .= $line;