dpkg (1.18.25) stretch; urgency=medium
[dpkg] / doc / lcov-inject.pl
CommitLineData
1479465f
GJ
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
21use strict;
22use warnings;
23
24use Cwd;
25use Devel::Cover::DB;
26
27my $dir = 'scripts';
28my $cwd = cwd();
29
30chdir $dir or die "cannot switch to $dir\n";
31
32my $db = Devel::Cover::DB->new(db => 'cover_db');
33$db = $db->merge_runs();
34$db->calculate_summary(map { $_ => 1 } $db->collected());
35
36chdir $cwd or die "cannot switch to $cwd\n";
37
38my $s = $db->{summary}{Total};
39
40my $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
55while (<>) {
56 s/^(.*<td .*href="src\/index\.html">.*)$/$tmpl$1/;
57 print;
58}
59
60sub 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
68sub 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
82sub box_rating {
83 my ($num) = @_;
84
85 return 'Hi' if $num >= 90;
86 return 'Lo' if $num < 75;
87 return 'Med';
88}
89
90sub 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
991;