Commit | Line | Data |
---|---|---|
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 | ||
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 %%</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; |