bin/post-prc-coverage.pl

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 prg. seems to be broken by Devel::Cover 0.59
   6
   7
   8
   9 The coverage analysis of CPAN.pm is difficult to read because the
  10 methods do not contain the package name.
  11
  12 Solution 1 would be to split the file, but I really like these things
  13 kept in one editor window.
  14
  15 Solution 2 would be to find the option in "cover" that writes the HTML
  16 and if it's not there, add it.
  17
  18 Solution 3 is to post-process the HTML. By far the simplest for me,
  19 even if it's the ugliest.
  20
  21 =cut
  22
  23 use strict;
  24 use warnings;
  25
  26 my $html = shift or die "Usage: $0 file-to-process";
  27
  28 my($hdir,$ppath,$type) = $html =~ m|(.+)/([^/]+)--(\w+)\.html$|;
  29 $ppath =~ s/-pm$/.pm/ or die;
  30 $ppath =~ s|-|/|g;
  31 -f $ppath or die;
  32
  33 open my $pfh, $ppath or die;
  34 my %line_sub_pkg;
  35 my $curpkg = "main";
  36 while (<$pfh>) {
  37   s/#.*//;
  38   $curpkg = $1 if /^\s*package\s+([\w:]+)/;
  39   if (/^sub (\w+)/) {
  40     for my $delta (0,1) {
  41       my $line = $. + $delta;
  42       $line_sub_pkg{"$line\:$1"} = $curpkg;
  43     }
  44   }
  45   last if /^__END__/;
  46 }
  47 close $pfh;
  48
  49 open my $rhfh, $html or die "Could not open $html\: $!";
  50 open my $whfh, ">", "$html.new" or die;
  51 while (<$rhfh>) {
  52   if (m|^(<tr>.*<div class="s">)(\w+)(</div></td></tr>)|) {
  53     my($hpre,$subr,$hpost) = ($1,$2,$3);
  54     my($line) = $hpre =~ /id="L(\d+)"/;
  55     if (my $pkg = $line_sub_pkg{"$line:$subr"}) {
  56       print $whfh "$hpre$pkg\::$subr$hpost\n";
  57     } else {
  58       print $whfh $_;
  59     }
  60   } else {
  61     print $whfh $_;
  62   }
  63 }
  64 close $rhfh;
  65 close $whfh;
  66 rename $html, "$html.old" or die;
  67 rename "$html.new", $html or die;