Patch for 1.23.0 - please comment

[Frank Lichtenheld <djpig@debian.org>]

Hi.

I prepared a patch for a particular set of false positives for udebs.
Since it is quite invasive for a small error I wanted to ask before I
apply it to branches/1.23.0

You find it attached. It introduces a new binary-pkgs collection script
that extract the fields for binary package out of debian/control of
source packages. Quite usefull for other tasks as well perhaps.

The actual fix is avoiding some false positives for
maintainer-script-lacks-debhelper-token in udeb packages.

Gruesse,
-- 
Frank Lichtenheld <djpig@debian.org>
www: http://www.djpig.de/

Index: checks/debhelper
===================================================================
--- checks/debhelper	(revision 208)
+++ checks/debhelper	(working copy)
@@ -89,13 +89,29 @@
 
 exit unless $seencommand;
 
+# We may need to make a difference between deb and udeb packages
+# so try to find out
+my %pkgs;
+opendir(BINPKGS, 'binary-pkgs')
+    or fail("Can't open binary-pkgs directory.");
+while(my $binpkg = readdir(BINPKGS)) {
+    if (-d "binary-pkgs/$binpkg") {
+        if (open TYPE, "<", "binary-pkgs/$binpkg/xc-package-type") {
+            $pkgs{$binpkg} = <TYPE> || 'deb';
+        } else {
+            $pkgs{$binpkg} = 'deb';
+        }
+    }
+}
+
 # If we got this far, they need to have #DEBHELPER# in their scripts.
 # search for scripts that look like maintainer scripts.
 opendir(DEBIAN, 'debfiles')
     or fail("Can't open debfiles directory.");
 while (defined(my $file=readdir(DEBIAN))) {
-    if ($file =~ m/^(?:.*\.)?(?:post|pre)(?:inst|rm)$/) {
+    if ($file =~ m/^(?:(.*)\.)?(?:post|pre)(?:inst|rm)$/) {
 	
+        my $binpkg = $1 || '';
 	open(IN,"debfiles/$file")
 	    or fail("Can't open debfiles/$file: $!");
 	my $seentag = '';
@@ -108,7 +124,7 @@
 	close IN;
 	
 	if ((! $seentag) and $needtomodifyscripts) {
-	    print "W: $pkg $type: maintainer-script-lacks-debhelper-token debian/$file\n";
+	    print "W: $pkg $type: maintainer-script-lacks-debhelper-token debian/$file\n" unless $binpkg && ($pkgs{$binpkg} =~ /udeb/i);
 	}
     } elsif ($file =~ m/^compat$/) {
 	open IN, "debfiles/$file"
Index: checks/debhelper.desc
===================================================================
--- checks/debhelper.desc	(revision 208)
+++ checks/debhelper.desc	(working copy)
@@ -5,7 +5,7 @@
 Type: source
 Unpack-Level: 2
 Info: This looks for common mistakes in debhelper source packages.
-Needs-Info: debfiles
+Needs-Info: debfiles, binary-pkgs
 
 Tag: maintainer-script-lacks-debhelper-token
 Type: warning

#!/usr/bin/perl -w
# binary-pkgs -- lintian collector script

# Copyright (C) 2004 Frank Lichtenheld
# 
# 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., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

use strict;
use warnings;

($#ARGV == 1) or fail("syntax: binary-pkgs <pkg> <type>");
my $pkg = shift;
my $type = shift;

-f "debfiles/control" or fail("binary-pkgs invoked in wrong directory");

use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;

my @control_data = read_dpkg_control("debfiles/control");
shift @control_data; # we don't need the source information

mkdir "binary-pkgs", 0777  or fail( "can't create dir binary-pkgs: $!" );

foreach (@control_data) {
    my $pkg_name = $_->{'package'};
    fail("no package line found in control file of $pkg $type")
        if !$pkg_name;
    mkdir "binary-pkgs/$pkg_name", 0777
        or fail( "can't create dir binary-pkgs/$pkg_name: $!" );
    for my $field (keys %$_) {
        my $field_file = "binary-pkgs/$pkg_name/$field";
        open F, ">", "$field_file"
            or fail("cannot open file $field_file for writing: $!");
        print F $_->{$field},"\n";
        close F;
    }
}

Collector-Script: binary-pkgs
Author: Frank Lichtenheld <djpig@debian.org>
Info: Collects information about binary packages from debian/control in source packages
Type: source
Unpack-Level: 1
Output: binary-pkgs
Order: 2
Needs-Info: debfiles