chiark - git - mdw - dpkg/blob - doc/lcov-inject.pl

   1 #!/usr/bin/perl
   2 #
   3 # lcov-inject.pl
   4 #
   5 # Copyright © 2014 Guillem Jover <guillem@debian.org>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  19 #
  20
  21 use strict;
  22 use warnings;
  23
  24 use Cwd;
  25 use Devel::Cover::DB;
  26
  27 my $dir = 'scripts';
  28 my $cwd = cwd();
  29
  30 chdir $dir or die "cannot switch to $dir\n";
  31
  32 my $db = Devel::Cover::DB->new(db => 'cover_db');
  33 $db = $db->merge_runs();
  34 $db->calculate_summary(map { $_ => 1 } $db->collected());
  35
  36 chdir $cwd or die "cannot switch to $cwd\n";
  37
  38 my $s = $db->{summary}{Total};
  39
  40 my $tmpl = sprintf '
  41       <td class="coverFile"><a href="%s">%s</a></td>
  42       <td class="coverBar" align="center">
  43         <table border=0 cellspacing=0 cellpadding=1>
  44           <tr><td class="coverBarOutline">%s</td></tr>
  45         </table>
  46       </td>
  47       %s
  48       %s
  49       %s
  50     </tr>
  51     <tr>
  52 ', "$dir/coverage.html", $dir, bar_html($s->{total}{percentage}),
  53    box_html($s->{total}), box_html($s->{subroutine}), box_html($s->{branch});
  54
  55 while (<>) {
  56     s/^(.*<td .*href="src\/index\.html">.*)$/$tmpl$1/;
  57     print;
  58 }
  59
  60 sub bar_image {
  61     my ($num) = @_;
  62
  63     return 'emerald.png' if $num >= 90;
  64     return 'ruby.png' if $num < 75;
  65     return 'amber.png';
  66 }
  67
  68 sub bar_html {
  69     my ($num) = @_;
  70
  71     my $html = sprintf '<img src="%s" width=%.0f height=10 alt="%.1f">',
  72                        bar_image($num), $num, $num;
  73
  74     if ($num < 100) {
  75         $html .= sprintf '<img src="snow.png" width=%.0f height=10 alt="%.1f">',
  76                          100 - $num, $num;
  77     }
  78
  79     return $html;
  80 }
  81
  82 sub box_rating {
  83     my ($num) = @_;
  84
  85     return 'Hi' if $num >= 90;
  86     return 'Lo' if $num < 75;
  87     return 'Med';
  88 }
  89
  90 sub box_html {
  91     my ($stats) = @_;
  92
  93     return sprintf '<td class="coverPer%s">%.1f&nbsp;%%</td>' . "\n" .
  94                    '<td class="coverNum%s">%d / %d</td>',
  95         box_rating($stats->{percentage}), $stats->{percentage},
  96         box_rating($stats->{percentage}), $stats->{covered}, $stats->{total};
  97 }
  98
  99 1;