1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
# debdiff -- Lintian check script -*- perl -*-
# Copyright (C) 1998 Richard Braakman
#
# 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, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
package Lintian::debdiff;
use strict;
use Tags;
use Util;
sub run {
my $pkg = shift;
my $type = shift;
open (VERSION, "fields/version") or fail("cannot open fields/version: $!");
chomp(my $version = <VERSION>);
close VERSION;
$version =~ s/^\d+://; #Remove epoch
if ((not -f "${pkg}_${version}.diff.gz") and
($version =~ /-/) and ($version !~ /-0\.[^-]+$/) ) {
tag_warn("native-package-with-dash-version");
}
open(STAT, "diffstat") or fail("cannot open diffstat file: $!");
while (<STAT>) {
chop;
my $file;
m/^\s+(.*?)\s+\|/
or fail("syntax error in diffstat file: $_");
$file = $1;
tag_warn("patch-failure-file-in-diff", $file)
if ($file =~ m/\.(orig|rej)$/);
tag_warn("editor-backup-file-in-diff", $file)
if ($file =~ m%((^|/)\.[^/]+\.swp|~)$% && /\|\s+\d+\s+\++$/);
tag_warn("diff-contains-substvars", $file)
if ($file =~ m%^debian/substvars$%);
}
close(STAT) or fail("error reading diffstat file: $!");
} # </run>
# ---------------------------------
sub tag_warn {
my $tag = shift;
if ($#_ >= 0) {
# We can't have newlines in a tag message, so turn them into \n
map { s,\n,\\n, } @_;
my $args = join(' ', @_);
tag "$tag", "$args";
} else {
tag "$tag", "";
}
}
1;
|
