diff options
author | Guillem Jover <guillem@debian.org> | 2015-01-21 01:05:53 +0100 |
---|---|---|
committer | Guillem Jover <guillem@debian.org> | 2015-01-28 20:50:30 +0100 |
commit | 96ff574ed0269199d0f6caa98a65fb14a9486684 (patch) | |
tree | 49dabbb5952807bc7034dc9de1ff63acaad6cb16 /doc/lcov-inject | |
parent | d7676a0374c682a8291e3bc11cae549d14dce04b (diff) | |
download | dpkg-96ff574ed0269199d0f6caa98a65fb14a9486684.tar.gz |
build: Rename perl scripts to have a .pl extension
This allows to easily replace the shebang at installation time to use
the system perl interpreter and will make it easier to analyze all
perl scripts in the source tree.
Diffstat (limited to 'doc/lcov-inject')
-rwxr-xr-x | doc/lcov-inject | 99 |
1 files changed, 0 insertions, 99 deletions
diff --git a/doc/lcov-inject b/doc/lcov-inject deleted file mode 100755 index eda121d5a..000000000 --- a/doc/lcov-inject +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl -# -# lcov-inject -# -# Copyright © 2014 Guillem Jover <guillem@debian.org> -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <https://www.gnu.org/licenses/>. -# - -use strict; -use warnings; - -use Cwd; -use Devel::Cover::DB; - -my $dir = 'scripts'; -my $cwd = cwd(); - -chdir $dir or die "cannot switch to $dir\n"; - -my $db = Devel::Cover::DB->new(db => 'cover_db'); -$db = $db->merge_runs(); -$db->calculate_summary(map { $_ => 1 } $db->collected()); - -chdir $cwd or die "cannot switch to $cwd\n"; - -my $s = $db->{summary}{Total}; - -my $tmpl = sprintf ' - <td class="coverFile"><a href="%s">%s</a></td> - <td class="coverBar" align="center"> - <table border=0 cellspacing=0 cellpadding=1> - <tr><td class="coverBarOutline">%s</td></tr> - </table> - </td> - %s - %s - %s - </tr> - <tr> -', "$dir/coverage.html", $dir, bar_html($s->{total}{percentage}), - box_html($s->{total}), box_html($s->{subroutine}), box_html($s->{branch}); - -while (<>) { - s/^(.*<td .*href="src\/index\.html">.*)$/$tmpl$1/; - print; -} - -sub bar_image { - my ($num) = @_; - - return 'emerald.png' if $num >= 90; - return 'ruby.png' if $num < 75; - return 'amber.png'; -} - -sub bar_html { - my ($num) = @_; - - my $html = sprintf '<img src="%s" width=%.0f height=10 alt="%.1f">', - bar_image($num), $num, $num; - - if ($num < 100) { - $html .= sprintf '<img src="snow.png" width=%.0f height=10 alt="%.1f">', - 100 - $num, $num; - } - - return $html; -} - -sub box_rating { - my ($num) = @_; - - return 'Hi' if $num >= 90; - return 'Lo' if $num < 75; - return 'Med'; -} - -sub box_html { - my ($stats) = @_; - - return sprintf '<td class="coverPer%s">%.1f %%</td>\n' . - '<td class="coverNum%s">%d / %d</td>', - box_rating($stats->{percentage}), $stats->{percentage}, - box_rating($stats->{percentage}), $stats->{covered}, $stats->{total}; -} - -1; |