[SCM] Debian package checker branch, master, updated. 2.5.1-97-gcfc9105

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit cfc910581f9bdce93c6764878e719e0b5ace698c
Author: Niels Thykier <niels@thykier.net>
Date:   Thu Jul 14 19:23:36 2011 +0200

    Split file-info to avoid it deadlocking with large output
    
    For large packages, file-info ended up deadlocking since
    xargs/file could not accept anymore and file-info was not reading.

diff --git a/collection/file-info b/collection/file-info
index a1acb65..5b7d530 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -22,6 +22,7 @@
 use strict;
 use warnings;
 
+use Cwd qw(realpath);
 use FileHandle;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
@@ -32,70 +33,31 @@ my $pkg = shift;
 my $type = shift;
 my $last = '';
 
+my $helper = realpath("$0-helper");
+my $outfile = realpath('./file-info');
+
 -f 'fields/source' or fail('file-info invoked in wrong directory');
 
-unlink('file-info');
+unlink($outfile);
 
 # Open files before we chdir, since unpacked could be a symlink (at
 # the time of writing, it never is, but it could be a reasonable way
 # of fixing #262783)
-open(FILE_INFO, '>', 'file-info')
-    or fail("cannot open file-info: $!");
+
 open(INDEX, '<', 'index')
     or fail("cannot open index file: $!");
 
 chdir('unpacked')
     or fail("cannot chdir to unpacked directory: $!");
 
-my $collect = sub {
-    my @lines = map { split "\n" } @_;
-    if ($last ne '') {
-        $lines[0] = $last . $lines[0];
-    }
-    if ($_[-1] !~ /\n\z/) {
-        $last = pop @lines;
-    } else {
-        $last = '';
-    }
-    for my $line (@lines) {
-        my ($file, $type) = $line =~ (m/^(.*?)\x00(.*)$/o);
-        if ($file =~ m/\.gz$/o && -e $file && ! -l $file && $type !~ m/compressed/o){
-            # While file could be right, it is unfortunately
-            # regularly wrong here as well; double check the type
-	    my $text = '';
-	    if (open(my $gzf, '<', $file)) {
-		my $buff;
-		# We need to read at least 9 bytes
-		if (sysread($gzf, $buff, 1024) >= 9) {
-		    # translation of the unpack
-		    #  nn nn ,  NN NN NN NN, nn nn, cc     - bytes read (in hex, network order)
-		    #  $magic,  __ __ __ __, __ __, $comp  - variables
-		    my ($magic, undef, undef, $comp) = unpack('nNnc', $buff);
-		    if ($magic == 0x1f8b){ # the gzip file magic
-			$text = 'gzip compressed data';
-			# 2 for max compression; RFC1952 suggests this is a flag and not a value,
-			# hench the bit and operation
-			if (($comp & 2) == 2){
-			    $text = "$text, max compression";
-			}
-		    }
-		}
-		close($gzf);
-	    }
-	    $type = "$type, $text" if $text;
-        }
-        printf FILE_INFO "%s%c%s\n", $file , 0, $type;
-    }
-}; # End $collect = sub;
-
 # We ignore failures from file because sometimes file returns a non-zero exit
 # status when it can't parse a file.  So far, the resulting output still
 # appears to be usable (although will contain "ERROR" strings, which Lintian
 # doesn't care about), and the only problem was the exit status.
 my %opts = ( pipe_in => FileHandle->new,
-	     out => $collect,
+	     out => $outfile,
 	     fail => 'never' );
-spawn(\%opts, ['xargs', '-0r', 'file', '-F', '', '--print0', '--']);
+spawn(\%opts, ['xargs', '-0r', 'file', '-F', '', '--print0', '--'], '|', [$helper]);
 $opts{pipe_in}->blocking(1);
 
 while (<INDEX>) {
@@ -112,5 +74,4 @@ close(INDEX) or fail("cannot close index file: $!");
 close $opts{pipe_in};
 reap(\%opts);
 
-close(FILE_INFO) or fail("cannot close file-info: $!");
 
diff --git a/collection/file-info-helper b/collection/file-info-helper
new file mode 100755
index 0000000..3c7bde0
--- /dev/null
+++ b/collection/file-info-helper
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+while ( my $line = <> ) {
+    my ($file, $type) = $line =~ (m/^(.*?)\x00(.*)$/o);
+    if ($file =~ m/\.gz$/o && -e $file && ! -l $file && $type !~ m/compressed/o){
+        # While file could be right, it is unfortunately
+        # regularly wrong here as well; double check the type
+        my $text = '';
+        if (open(my $gzf, '<', $file)) {
+            my $buff;
+            # We need to read at least 9 bytes
+            if (sysread($gzf, $buff, 1024) >= 9) {
+                # translation of the unpack
+                #  nn nn ,  NN NN NN NN, nn nn, cc     - bytes read (in hex, network order)
+                #  $magic,  __ __ __ __, __ __, $comp  - variables
+                my ($magic, undef, undef, $comp) = unpack('nNnc', $buff);
+                if ($magic == 0x1f8b){ # the gzip file magic
+                    $text = 'gzip compressed data';
+                    # 2 for max compression; RFC1952 suggests this is a flag and not a value,
+                    # hench the bit and operation
+                    if (($comp & 2) == 2){
+                        $text = "$text, max compression";
+                    }
+                }
+		}
+            close($gzf);
+        }
+        $type = "$type, $text" if $text;
+    }
+    printf "%s%c%s\n", $file , 0, $type;
+}
+

-- 
Debian package checker