[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.5-11-ge94cee4



The following commit has been merged in the master branch:
commit e94cee45f4629af3a421dff495631775b69d07b5
Author: Niels Thykier <niels@thykier.net>
Date:   Wed Mar 7 13:44:45 2012 +0100

    coll/*: Refactored to use new $dir argument as path to package
    
    Pass a 3rd argument to all collections, which is the path to the
    package being examined.  This means that:
    
     * lintian no longer needs to use rundir (etc.) to run collections.
     * collections can now use Lintian::Collect "for free".
       - previously they would have to do "cwd" (or refain from
         chdir'ing).
    
    The latter effect can be exploited to reduce the "coupling" between
    various collections.
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/collection/ar-info b/collection/ar-info
index a512e15..9907590 100755
--- a/collection/ar-info
+++ b/collection/ar-info
@@ -27,19 +27,20 @@ use FileHandle;
 use Lintian::Command qw(spawn);
 use Util qw(fail);
 
-($#ARGV == 1) or fail('syntax: ar-info <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: ar-info <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
-unlink('ar-info');
+if ( -e "$dir/ar-info" ) {
+    unlink "$dir/ar-info" or fail "unlink ar-info: $!";
+}
 
 # Open before chdir, as unpacked may be a symlink
-open(INDEX, '<', 'index')
+open INDEX, '<', "$dir/index"
     or fail("cannot open index file: $!");
-open(OUT, '>', 'ar-info')
+open OUT, '>', "$dir/ar-info"
     or fail("cannot open ar-info file: $!");
 
-chdir('unpacked')
+chdir ("$dir/unpacked")
     or fail("cannot chdir to unpacked directory: $!");
 
 while (<INDEX>) {
diff --git a/collection/bin-pkg-control b/collection/bin-pkg-control
index 8b8a80d..e973a1a 100755
--- a/collection/bin-pkg-control
+++ b/collection/bin-pkg-control
@@ -26,49 +26,48 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 use Lintian::Command qw(spawn reap);
 
-($#ARGV == 1) or fail('syntax: bin-pkg-control <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: bin-pkg-control <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 my (@jobs, $job);
 
-if (-e 'control'){
-    delete_dir('control') or fail('Cannot remove old control dir');
+if ( -e "$dir/control"){
+    delete_dir ("$dir/control") or fail 'Cannot remove old control dir';
 }
 
-mkdir('control', 0777) or fail("mkdir control: $!");
+mkdir ("$dir/control", 0777) or fail "mkdir control: $!";
 
 # The following calls use knowledge of the .deb format for speed
 
 # (replaces dpkg-deb -e)
 # extract control files' tarball
-spawn({ fail => 'error', out => 'control.tar' },
-      ['ar', 'p', 'deb', 'control.tar.gz'],
+spawn ({ fail => 'error', out => "$dir/control.tar" },
+      ['ar', 'p', "$dir/deb", 'control.tar.gz'],
       '|', ['gzip', '-dc']);
 
-$job = { fail => 'error', err => 'control-errors' };
+$job = { fail => 'error', err => "$dir/control-errors" };
 push @jobs, $job;
 # extract the tarball's contents
 spawn($job,
-      ['tar', 'xf', 'control.tar', '-C', 'control', '&']);
+      ['tar', 'xf', "$dir/control.tar", '-C', "$dir/control", '&']);
 
 $job = { fail => 'error',
-         out  => 'control-index',
-         err  => 'control-index-errors' };
+         out  => "$dir/control-index",
+         err  => "$dir/control-index-errors" };
 
 push @jobs, $job;
 # create index of control.tar.gz
 spawn($job,
-      ['tar', 'tvf', 'control.tar'],
+      ['tar', 'tvf', "$dir/control.tar"],
       '|', ['sort', '-k', '6'], '&');
 
 reap(@jobs);
 undef @jobs;
 # clean up control.tar
-unlink('control.tar') or fail();
+unlink "$dir/control.tar" or fail "unlink control.tar: $!";
 
 # fix permissions
 spawn({ fail => 'error' },
-      ['chmod', '-R', 'u+rX,o-w', 'control']);
+      ['chmod', '-R', 'u+rX,o-w', "$dir/control"]);
 
 exit 0;
 
diff --git a/collection/changelog-file b/collection/changelog-file
index a2d4a70..a092306 100755
--- a/collection/changelog-file
+++ b/collection/changelog-file
@@ -25,26 +25,25 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: changelog-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: changelog-file <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
 
-unlink('changelog') or fail("cannot remove changelog file: $!")
-    if ( -e 'changelog' or -l 'changelog');
+unlink "$dir/changelog" or fail "cannot remove changelog file: $!"
+    if -e "$dir/changelog" or -l "$dir/changelog";
 
 # Pick the first of these files that exists.
-my @changelogs = ("unpacked/usr/share/doc/$pkg/changelog.Debian.gz",
-                  "unpacked/usr/share/doc/$pkg/changelog.Debian",
-                  "unpacked/usr/share/doc/$pkg/changelog.debian.gz",
-                  "unpacked/usr/share/doc/$pkg/changelog.debian",
-                  "unpacked/usr/share/doc/$pkg/changelog.gz",
-                  "unpacked/usr/share/doc/$pkg/changelog",
-                  "unpacked/usr/doc/$pkg/changelog.Debian.gz",
-                  "unpacked/usr/doc/$pkg/changelog.Debian",
-                  "unpacked/usr/doc/$pkg/changelog.debian.gz",
-                  "unpacked/usr/doc/$pkg/changelog.debian",
-                  "unpacked/usr/doc/$pkg/changelog.gz",
-                  "unpacked/usr/doc/$pkg/changelog");
+my @changelogs = ("$dir/unpacked/usr/share/doc/$pkg/changelog.Debian.gz",
+                  "$dir/unpacked/usr/share/doc/$pkg/changelog.Debian",
+                  "$dir/unpacked/usr/share/doc/$pkg/changelog.debian.gz",
+                  "$dir/unpacked/usr/share/doc/$pkg/changelog.debian",
+                  "$dir/unpacked/usr/share/doc/$pkg/changelog.gz",
+                  "$dir/unpacked/usr/share/doc/$pkg/changelog",
+                  "$dir/unpacked/usr/doc/$pkg/changelog.Debian.gz",
+                  "$dir/unpacked/usr/doc/$pkg/changelog.Debian",
+                  "$dir/unpacked/usr/doc/$pkg/changelog.debian.gz",
+                  "$dir/unpacked/usr/doc/$pkg/changelog.debian",
+                  "$dir/unpacked/usr/doc/$pkg/changelog.gz",
+                  "$dir/unpacked/usr/doc/$pkg/changelog");
 
 my $chl;
 
@@ -63,7 +62,7 @@ for (@changelogs) {
 if (defined ($chl) && -l $chl) {
     my $link = readlink $chl or fail("cannot readlink $chl: $!");
     if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
-        symlink('file-is-in-another-package', 'changelog')
+        symlink ("$dir/file-is-in-another-package", "$dir/changelog")
             or fail("cannot create changelog symlink: $!");
         undef $chl;
     } elsif (! -f $chl) {
@@ -78,16 +77,16 @@ if (defined ($chl) && -l $chl) {
 if (not defined $chl) {
     # no changelog found
 } elsif ($chl =~ /\.gz$/) {
-    gunzip_file($chl, 'changelog');
+    gunzip_file ($chl, "$dir/changelog");
 } elsif (-f $chl && -l $chl) {
     local $_;
     open (CHL, '<', $chl) or fail("cannot open $chl: $!");
-    open (COPY, '>', 'changelog') or fail("cannot create changelog: $!");
+    open (COPY, '>', "$dir/changelog") or fail "cannot create changelog: $!";
     print COPY while <CHL>;
     close CHL;
     close (COPY) or fail("cannot write changelog: $!");
 } else {
-    link($chl, 'changelog')
+    link ($chl, "$dir/changelog")
         or fail("cannot link $chl to changelog: $!");
 }
 
@@ -95,7 +94,7 @@ if ($chl && $chl !~ m/changelog\.debian/i) {
     # Either this is a native package OR a non-native package where the
     # debian changelog is missing.  checks/changelog is not too happy
     # with the latter case, so check looks like a Debian changelog.
-    open my $fd, '<', 'changelog' or fail "Opening changelog: $!";
+    open my $fd, '<', "$dir/changelog" or fail "Opening changelog: $!";
     my $ok = 0;
     while ( my $line = <$fd> ) {
         next if $line =~ m/^\s*+$/o;
@@ -108,14 +107,14 @@ if ($chl && $chl !~ m/changelog\.debian/i) {
     }
     close $fd;
     # Remove it if it not the Debian changelog.
-    unlink 'changelog' unless $ok;
+    unlink "$dir/changelog" unless $ok;
 }
 
 # Extract NEWS.Debian files as well, with similar precautious.  Ignore any
 # symlinks to other packages here; in that case, we just won't check the file.
-unlink('NEWS.Debian') or fail("cannot unlink NEWS.Debian: $!")
-    if (-e 'NEWS.Debian' or -l 'NEWS.Debian');
-my $news = "unpacked/usr/share/doc/$pkg/NEWS.Debian.gz";
+unlink "$dir/NEWS.Debian" or fail "cannot unlink NEWS.Debian: $!"
+    if -e "$dir/NEWS.Debian" or -l "$dir/NEWS.Debian";
+my $news = "$dir/unpacked/usr/share/doc/$pkg/NEWS.Debian.gz";
 if (-f $news) {
     if (-l $news) {
         my $link = readlink $news or fail("cannot readlink $chl: $!");
@@ -126,7 +125,7 @@ if (-f $news) {
         }
     }
     if ($news) {
-        gunzip_file($news, 'NEWS.Debian');
+        gunzip_file ($news, "$dir/NEWS.Debian");
     }
 }
 
diff --git a/collection/copyright-file b/collection/copyright-file
index ad11fcc..7185816 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -27,14 +27,15 @@ use Util;
 
 use File::Copy qw(copy);
 
-($#ARGV == 1) or fail('syntax: copyright-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: copyright-file <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
-unlink('copyright');
+if ( -e "$dir/copyright" ) {
+    unlink "$dir/copyright" or fail "unlink copyright: $!";
+}
 
-my $file1 = "unpacked/usr/share/doc/$pkg/copyright";
-my $file2 = "unpacked/usr/doc/$pkg/copyright";
+my $file1 = "$dir/unpacked/usr/share/doc/$pkg/copyright";
+my $file2 = "$dir/unpacked/usr/doc/$pkg/copyright";
 
 my $file;
 if (-f $file1 ) { $file = $file1; }
@@ -46,18 +47,18 @@ else { $file = $file2; }
 if (-l $file) {
     my $link = readlink($file) or fail("cannot readlink $file: $!");
     if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
-        touch_file('copyright');
+        touch_file "$dir/copyright";
     } else {
-        copy($file, 'copyright') or fail("cannot copy $file: $!");
+        copy ($file, "$dir/copyright") or fail "cannot copy $file: $!";
     }
 } elsif (-f $file) {
-    link($file, 'copyright')
+    link ($file, "$dir/copyright")
         or fail("cannot link $file to copyright: $!");
 } elsif (-f "$file.gz") {
-    gunzip_file($file, 'copyright');
+    gunzip_file ($file, "$dir/copyright");
 } else {
     # no copyright file found
-    touch_file('copyright');
+    touch_file ("$dir/copyright");
 }
 
 # Local Variables:
diff --git a/collection/debfiles b/collection/debfiles
index 6fc4bdf..42f48e1 100755
--- a/collection/debfiles
+++ b/collection/debfiles
@@ -26,21 +26,20 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: debfiles <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: debfiles <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
--e 'unpacked' or fail('debfiles invoked in wrong directory');
+-e "$dir/unpacked" or fail 'debfiles invoked with wrong dir argument';
 
-if (-e 'debfiles') {
-    delete_dir('debfiles')
+if ( -e "$dir/debfiles") {
+    delete_dir ("$dir/debfiles")
         or fail('cannot rm old debfiles directory');
 }
 
-if ( -l 'unpacked/debian' ) {
+if ( -l "$dir/unpacked/debian" ) {
     require Cwd;
-    my $target = Cwd::abs_path ('unpacked/debian');
-    my $ud = Cwd::abs_path ('unpacked');
+    my $target = Cwd::abs_path ("$dir/unpacked/debian");
+    my $ud = "$dir/unpacked";
     fail ("cannot resolve debian directory symlink in $pkg: $!") unless $target;
     fail ("cannot resolve unpacked dir for $pkg: $!") unless $ud;
     # We need the the trailing slash on $ud to ensure $target is a subdir of $ud.  However
@@ -50,7 +49,7 @@ if ( -l 'unpacked/debian' ) {
 }
 
 # Copy the whole debian directory
-copy_dir('unpacked/debian/', 'debfiles')
+copy_dir ("$dir/unpacked/debian/", "$dir/debfiles")
     or fail("cannot copy unpacked/debian to debfiles: $!");
 
 # Local Variables:
diff --git a/collection/debian-readme b/collection/debian-readme
index 79d342d..afef8a3 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -25,23 +25,22 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: debian-readme <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: debian-readme <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
-if (-f 'README.Debian') {
-    unlink('README.Debian') or fail("Could not remove old README.Debian: $!");
+if ( -f "$dir/README.Debian") {
+    unlink "$dir/README.Debian" or fail "Could not remove old README.Debian: $!";
 }
 
 # Pick the first of these files that exists.
-my @readmes = ("unpacked/usr/share/doc/$pkg/README.Debian.gz",
-               "unpacked/usr/share/doc/$pkg/README.Debian",
-               "unpacked/usr/share/doc/$pkg/README.debian.gz",
-               "unpacked/usr/share/doc/$pkg/README.debian",
-               "unpacked/usr/doc/$pkg/README.Debian.gz",
-               "unpacked/usr/doc/$pkg/README.Debian",
-               "unpacked/usr/doc/$pkg/README.debian.gz",
-               "unpacked/usr/doc/$pkg/README.debian");
+my @readmes = ("$dir/unpacked/usr/share/doc/$pkg/README.Debian.gz",
+               "$dir/unpacked/usr/share/doc/$pkg/README.Debian",
+               "$dir/unpacked/usr/share/doc/$pkg/README.debian.gz",
+               "$dir/unpacked/usr/share/doc/$pkg/README.debian",
+               "$dir/unpacked/usr/doc/$pkg/README.Debian.gz",
+               "$dir/unpacked/usr/doc/$pkg/README.Debian",
+               "$dir/unpacked/usr/doc/$pkg/README.debian.gz",
+               "$dir/unpacked/usr/doc/$pkg/README.debian");
 
 my $file;
 for (@readmes) {
@@ -53,11 +52,11 @@ for (@readmes) {
 
 if (not defined $file) {
     # no README found
-    touch_file('README.Debian');
+    touch_file ("$dir/README.Debian");
 } elsif ($file =~ m/\.gz$/) {
-    gunzip_file($file, 'README.Debian');
+    gunzip_file ($file, "$dir/README.Debian");
 } else {
-    link($file, 'README.Debian')
+    link ($file, "$dir/README.Debian")
         or fail("cannot link $file to README.Debian: $!");
 }
 
diff --git a/collection/diffstat b/collection/diffstat
index 5f40a5f..62d9798 100755
--- a/collection/diffstat
+++ b/collection/diffstat
@@ -31,31 +31,31 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: diffstat <pkg> <type>');
-my $pkg = shift;
+($#ARGV == 2) or fail 'syntax: diffstat <pkg> <type> <dir>';
+my ($pkg, undef, $dir) = @ARGV;
 my $data;
 my $ver;
 
--f 'dsc' or fail('diffstat invoked in wrong directory');
+-f "$dir/dsc" or fail 'diffstat invoked with wrong dir argument';
 
-$data = get_dsc_info('dsc');
+$data = get_dsc_info ("$dir/dsc");
 $ver = $data->{'version'};
 
-unlink('debian-patch') or fail("cannot unlink debian-patch: $!")
-    if( -e 'debian-patch' or -l 'debian-patch');
+unlink "$dir/debian-patch" or fail "cannot unlink debian-patch: $!"
+    if -e "$dir/debian-patch" or -l "$dir/debian-patch";
 
 $ver =~ s/^\d://; #Remove epoch for this
 
-my $diff_file = "${pkg}_${ver}.diff.gz";
+my $diff_file = "$dir/${pkg}_${ver}.diff.gz";
 exit 0 unless (-f $diff_file);
 
-gunzip_file($diff_file, 'debian-patch');
+gunzip_file($diff_file, "$dir/debian-patch");
 
-open (STAT, '>', 'diffstat') or fail("cannot open scripts output file: $!");
+open STAT, '>', "$dir/diffstat" or fail "cannot open scripts output file: $!";
 # diffstat is noisy on stderr if its stdout is not a tty.
 # Shut it up by redirecting stderr to /dev/null.
 open STDERR, '>', '/dev/null';
-open (DIFF, '-|', qw/diffstat -p1 debian-patch/)
+open DIFF, '-|', 'diffstat',  '-p1', "$dir/debian-patch"
   or fail("cannot open pipe to diffstat on debian-patch: $!");
 # Copy all except last line to the STAT file
 my $previous;
diff --git a/collection/doc-base-files b/collection/doc-base-files
index 1350fe0..a68b1c5 100755
--- a/collection/doc-base-files
+++ b/collection/doc-base-files
@@ -26,22 +26,20 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: doc-base-files <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: doc-base-files <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
-
-if (-e 'doc-base') {
-    delete_dir('doc-base')
+if ( -e "$dir/doc-base") {
+    delete_dir ("$dir/doc-base")
         or fail('cannot rm old doc-base directory');
 }
 
-if (-d 'unpacked/usr/share/doc-base') {
-    copy_dir('unpacked/usr/share/doc-base', 'doc-base')
+if ( -d "$dir/unpacked/usr/share/doc-base") {
+    copy_dir ("$dir/unpacked/usr/share/doc-base", "$dir/doc-base")
         or fail('cannot copy directory unpacked/usr/share/doc-base');
 } else {
     # no doc-base directory
-    mkdir('doc-base', 0777) or fail("cannot mkdir doc-base: $!");
+    mkdir ("$dir/doc-base", 0777) or fail "cannot mkdir doc-base: $!";
 }
 
 # Local Variables:
diff --git a/collection/file-info b/collection/file-info
index 63f2bc0..ec86e15 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -28,24 +28,21 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 use Lintian::Command qw(spawn reap);
 
-($#ARGV == 1) or fail('syntax: file-info <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: file-info <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 my $last = '';
 
 my $helper = realpath("$0-helper");
-my $outfile = realpath('./file-info');
+my $outfile = "$dir/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)
+if ( -e $outfile ) {
+    unlink($outfile) or fail "unlink file-info: $!";
+}
 
-open(INDEX, '<', 'index')
+open INDEX, '<', "$dir/index"
     or fail("cannot open index file: $!");
 
-chdir('unpacked')
+chdir ("$dir/unpacked")
     or fail("cannot chdir to unpacked directory: $!");
 
 # We ignore failures from file because sometimes file returns a non-zero exit
diff --git a/collection/index b/collection/index
index 89f2543..a276508 100755
--- a/collection/index
+++ b/collection/index
@@ -34,12 +34,11 @@ use Util;
 use Lintian::Command qw(spawn reap);
 use Lintian::Processable::Package;
 
-($#ARGV == 1) or fail 'syntax: index <pkg> <type>';
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail 'syntax: index <pkg> <type> <dir>';
+my ($pkg, $type, $dir) = @ARGV;
 
-unlink 'index' or fail "Could not unlink index: $!" if -e 'index' && -s 'index';
-unlink 'index-errors' or fail "Could not unlink index-errors: $!" if -e 'index-errors' && -s 'index-errors';
+unlink "$dir/index" or fail "Could not unlink index: $!" if -e "$dir/index";
+unlink "$dir/index-errors" or fail "Could not unlink index-errors: $!" if -e "$dir/index-errors";
 
 if ($type ne 'source') {
     index_deb();
@@ -51,16 +50,14 @@ exit 0;
 
 # returns all (orig) tarballs.
 sub gather_tarballs {
-    my $file = Cwd::realpath('dsc');
-    my $dir;
+    my $file = Cwd::realpath ("$dir/dsc");
     my $data;
     my $version;
     my @tarballs;
     my $base;
     my $baserev;
     my $proc;
-    fail "Cannot resolve \"dsc\" link for $pkg or it does not point to a file.\n" unless $file and -e $file;
-    (undef, $dir, undef) = File::Spec->splitpath($file);
+    fail "Cannot resolve \"dsc\" link for $pkg or it does not point to a file." unless $file and -e $file;
     # Use Lintian::Processable::Package to determine source and version as handles missing fields
     # for us to some extend.
     $proc = Lintian::Processable::Package->new ('source', $file);
@@ -125,8 +122,8 @@ sub index_src {
                 }
             }
         }; # End $collect = sub;
-        spawn({ fail => 'never', out => $collect, err_append => 'index-errors' },
-              ['tar', @tar_options, $tarball]);
+        spawn({ fail => 'never', out => $collect, err_append => "$dir/index-errors" },
+              ['tar', @tar_options, "$dir/$tarball"]);
         if ($last) {
             fail("tar output (for $tarball from $pkg) does not end in a newline");
         }
@@ -176,7 +173,7 @@ sub index_src {
                 } @index;
                 my $filename = 'source-prefix';
                 $filename .= "-$compname" if $compname;
-                open(PREFIX, '>', $filename)
+                open PREFIX, '>', "$dir/$filename"
                     or fail "opening $filename for $pkg: $!";
                 print PREFIX "$prefix\n";
                 close PREFIX or fail "closing $filename for $pkg: $!";
@@ -190,7 +187,7 @@ sub index_src {
     }
     # Now that we have the file names we want, write them out sorted to the index
     # file.
-    spawn({ fail => 'error', out_append => 'index' },
+    spawn({ fail => 'error', out_append => "$dir/index" },
           sub { print @result }, '|', ['sort', '-k', '6']);
     return 1;
 }
@@ -200,29 +197,29 @@ sub index_deb {
     my (@jobs, $job);
 
     foreach my $file (qw(index index-errors index-owner-id)) {
-        unlink $file or fail "$file: $!" if -f $file;
+        unlink "$dir/$file" or fail "$file: $!" if -f "$dir/$file";
     }
 
     $job = { fail => 'error',
-             out  => 'index',
-             err  => 'index-errors' };
+             out  => "$dir/index",
+             err  => "$dir/index-errors" };
     push @jobs, $job;
     # (replaces dpkg-deb -c)
     # create index file for package
     spawn($job,
-          ['dpkg-deb', '--fsys-tarfile', 'deb' ],
+          ['dpkg-deb', '--fsys-tarfile', "$dir/deb" ],
           '|', ['tar', 'tfv', '-'],
           '|', ['sed', '-e', 's/^h/-/'],
           '|', ['sort', '-k', '6'], '&');
 
     $job = { fail => 'error',
-             out  => 'index-owner-id',
+             out  => "$dir/index-owner-id",
              err  => '/dev/null' };
     push @jobs, $job;
     # (replaces dpkg-deb -c)
     # create index file for package with owner IDs instead of names
     spawn($job,
-          ['dpkg-deb', '--fsys-tarfile', 'deb' ],
+          ['dpkg-deb', '--fsys-tarfile', "$dir/deb" ],
           '|', ['tar', '--numeric-owner', '-tvf', '-'],
           '|', ['sed', '-e', 's/^h/-/'],
           '|', ['sort', '-k', '6'], '&');
diff --git a/collection/init.d b/collection/init.d
index 769e294..370e3c8 100755
--- a/collection/init.d
+++ b/collection/init.d
@@ -25,21 +25,20 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: init.d <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: init.d <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
 
-if (-e 'init.d') {
-    delete_dir('init.d')
+if (-e "$dir/init.d") {
+    delete_dir ("$dir/init.d")
         or fail('cannot rm old init.d directory');
 }
 
-if (-d 'unpacked/etc/init.d') {
-    copy_dir('unpacked/etc/init.d', 'init.d')
+if (-d "$dir/unpacked/etc/init.d") {
+    copy_dir("$dir/unpacked/etc/init.d", "$dir/init.d")
         or fail('cannot copy init.d directory');
 } else {
     # no etc/init.d
-    mkdir('init.d', 0777) or fail("cannot mkdir init.d: $!");
+    mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
 }
 
 # Local Variables:
diff --git a/collection/java-info b/collection/java-info
index e3a85bb..f8ff49d 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -25,18 +25,20 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib/";
 use Util qw(fail);
 
+my ($pkg, undef, $dir) = @ARGV;
+
 # Sanity check
-unless (-d 'unpacked/') {
-    fail "java-info called in wrong directory!";
+unless ( -d "$dir/unpacked/") {
+    fail "java-info called with the wrong dir argument!";
 }
 
-open (INDEX, '<', 'index')
-    or fail "cannot open index: $!\n";
+open INDEX, '<', "$dir/index"
+    or fail "cannot open index: $!";
 
-open (OUT, '>', 'java-info')
+open OUT, '>', "$dir/java-info"
     or fail "cannot open java-info: $!";
 
-chdir ('unpacked')
+chdir ("$dir/unpacked")
     or fail "unable to chdir to unpacked: $!";
 
 while (<INDEX>) {
diff --git a/collection/md5sums b/collection/md5sums
index f695efc..f6dd186 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -22,19 +22,20 @@
 use strict;
 use warnings;
 
-use Cwd();
 use FileHandle;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Lintian::Command qw(spawn reap);
 use Util;
 
-($#ARGV == 1) or fail('syntax: md5sums <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
-my $dir = Cwd::cwd();
+($#ARGV == 2) or fail 'syntax: md5sums <pkg> <type> <dir>';
 
-unlink('md5sums');
-chdir('unpacked')
+my ($pkg, $type, $dir) = @ARGV;
+
+if ( -e "$dir/md5sums" ) {
+    unlink "$dir/md5sums" or fail "unlink md5sums: $!";
+}
+
+chdir ("$dir/unpacked")
     or fail("cannot chdir to unpacked directory: $!");
 
 my %opts = ( pipe_in => FileHandle->new,
diff --git a/collection/menu-files b/collection/menu-files
index 3bd390b..865fb25 100755
--- a/collection/menu-files
+++ b/collection/menu-files
@@ -25,16 +25,15 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: menu-files <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: menu-files <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
 
-if (-e 'menu') {
-    delete_dir('menu')
+if ( -e "$dir/menu") {
+    delete_dir ("$dir/menu")
         or fail('cannot rm old menu directory');
 }
 
-mkdir('menu', 0777) or fail("cannot mkdir menu: $!");
+mkdir ("$dir/menu", 0777) or fail ("cannot mkdir menu: $!");
 
 my %dirs;
 $dirs{'share'}   = 'usr/share/menu';
@@ -42,12 +41,12 @@ $dirs{'lib'}     = 'usr/lib/menu';
 $dirs{'methods'} = 'etc/menu-methods';
 
 while (my ($shortn, $path) = each %dirs) {
-    if (-d "unpacked/$path") {
-         copy_dir("unpacked/$path", "menu/$shortn")
+    if (-d "$dir/unpacked/$path") {
+         copy_dir ("$dir/unpacked/$path", "$dir/menu/$shortn")
             or fail("cannot copy unpacked/$path/ directory");
     } else {
         # no menu directory
-        mkdir("menu/$shortn", 0777) or fail("cannot mkdir menu/$shortn: $!");
+        mkdir ("$dir/menu/$shortn", 0777) or fail ("cannot mkdir menu/$shortn: $!");
     }
 }
 
diff --git a/collection/objdump-info b/collection/objdump-info
index 51fdb1b..5b7f619 100755
--- a/collection/objdump-info
+++ b/collection/objdump-info
@@ -26,15 +26,17 @@
 use strict;
 use warnings;
 
+my (undef, undef, $dir) = @ARGV;
+
 my $failed = 0;
 
-open (FILES, '<', 'file-info')
+open FILES, '<', "$dir/file-info"
     or fail("cannot open file-info: $!");
 
-open (OUT, '>', 'objdump-info')
+open OUT, '>', "$dir/objdump-info"
     or fail("cannot open objdump-info: $!");
 
-chdir ('unpacked')
+chdir ("$dir/unpacked")
     or fail ("unable to chdir to unpacked: $!\n");
 
 while (<FILES>) {
diff --git a/collection/override-file b/collection/override-file
index 9959476..94578cf 100755
--- a/collection/override-file
+++ b/collection/override-file
@@ -26,24 +26,23 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Util;
 
-($#ARGV == 1) or fail('syntax: override-file <pkg> <type>');
-my $pkg = shift;
-my $type = shift;
+($#ARGV == 2) or fail('syntax: override-file <pkg> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
 
--d 'unpacked' or fail('override-file invoked in wrong directory');
+-d "$dir/unpacked" or fail 'override-file invoked with wrong dir argument';
 
-if (-e 'override'){
-    unlink('override') or fail("could not remove old override file: $!");
+if ( -e "$dir/override"){
+    unlink "$dir/override" or fail "could not remove old override file: $!";
 }
 
 # Pick the first of these files that exists.  Prefer source/lintian-overrides
 # to source.lintian-overrides for source packages.
 my (@overrides, $file);
 if ($type eq 'source') {
-    @overrides = qw(unpacked/debian/source/lintian-overrides
-                    unpacked/debian/source.lintian-overrides);
+    @overrides = ("$dir/unpacked/debian/source/lintian-overrides",
+                  "$dir/unpacked/debian/source.lintian-overrides");
 } else {
-    @overrides = ("unpacked/usr/share/lintian/overrides/$pkg");
+    @overrides = ("$dir/unpacked/usr/share/lintian/overrides/$pkg");
 }
 for my $override (@overrides) {
     if (-f $override) {
@@ -56,9 +55,9 @@ for my $override (@overrides) {
 if (not defined $file) {
     # no override found
 } elsif ($file =~ /\.gz$/) {
-    gunzip_file($file, 'override');
+    gunzip_file ($file, "$dir/override");
 } else {
-    link($file, 'override')
+    link ($file, "$dir/override")
         or fail("cannot link $file to override: $!");
 }
 
diff --git a/collection/scripts b/collection/scripts
index 437506d..7b8acf3 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -25,8 +25,10 @@ use warnings;
 use lib "$ENV{'LINTIAN_ROOT'}/lib/";
 use Util qw(fail);
 
-open(SCRIPTS, '>', 'scripts') or fail("cannot open scripts output file: $!");
-open(INDEX, '<', 'index') or fail("cannot open index file: $!");
+my (undef, undef, $dir) = @ARGV;
+
+open SCRIPTS, '>', "$dir/scripts" or fail "cannot open scripts output file: $!";
+open INDEX, '<', "$dir/index" or fail "cannot open index file: $!";
 
 my $file;
 my $magic;
@@ -43,7 +45,7 @@ while (<INDEX>) {
     $file =~ s/ link to .*//;    # cut off info about hard links
     # This used to call fail() instead of next.  However, the check to
     # see if all files in the index can be opened should be done elsewhere.
-    open(FILE, '<', "unpacked/$file") or next;
+    open(FILE, '<', "$dir/unpacked/$file") or next;
     if (read(FILE, $magic, 2) and $magic eq '#!' and not eof(FILE)) {
         $scriptpath = <FILE>;
         chomp($scriptpath);
@@ -70,15 +72,15 @@ while (<INDEX>) {
 close(INDEX);
 close(SCRIPTS) or fail("cannot write scripts file: $!");
 
-open(SCRIPTS, '>', 'control-scripts')
+open SCRIPTS, '>', "$dir/control-scripts"
     or fail("cannot open control-scripts output file: $!");
 
-opendir(CONTROL, 'control')
+opendir CONTROL, "$dir/control"
     or fail("cannot read control directory: $!");
 
 for $file (readdir CONTROL) {
-    next unless -f "control/$file";
-    open(FILE, '<', "control/$file") or fail("cannot open control/$file: $!");
+    next if -l "$dir/control/$file" or ! -f _;
+    open FILE, '<', "$dir/control/$file" or fail "cannot open control/$file: $!";
     if (read(FILE, $magic, 2) and $magic eq '#!') {
         $scriptpath = <FILE>;
         $scriptpath =~ s/^\s*(\S*).*/$1/s;
diff --git a/collection/strings b/collection/strings
index b74b88f..c8153a2 100755
--- a/collection/strings
+++ b/collection/strings
@@ -27,19 +27,26 @@ use Util;
 use Lintian::Command qw(spawn);
 use Lintian::Command::Simple;
 
-($#ARGV == 1) or fail('syntax: strings <pkg> <type>');
+($#ARGV == 2) or fail('syntax: strings <pkg> <type> <dir>');
 
--f 'file-info'
-    or fail('file-info invoked in wrong directory');
+my (undef, undef, $dir) = @ARGV;
 
-unlink('elf-index');
-delete_dir('strings');
+-f "$dir/file-info"
+    or fail 'strings invoked in wrong directory';
 
-open(ELF_INDEX, '>', 'elf-index')
-    or fail("Could not open 'elf-index' for writing: $!\n");
+if ( -e "$dir/elf-index" ) {
+    unlink "$dir/elf-index" or fail "unlink elf-index: $!";
+}
+
+if ( -d "$dir/strings" ) {
+    delete_dir ("$dir/strings") or fail "rmdir strings: $!";
+}
+
+open ELF_INDEX, '>', "$dir/elf-index"
+    or fail "Could not open 'elf-index' for writing: $!";
 
-open(FILE_INFO, '<', 'file-info')
-    or fail("Could not open 'file-info' for reading: $!\n");
+open FILE_INFO, '<', "$dir/file-info"
+    or fail "Could not open 'file-info' for reading: $!";
 
 while (<FILE_INFO>) {
     next unless(m/^(.+?)\x00\s+[^,]*\bELF\b/);
@@ -49,13 +56,13 @@ while (<FILE_INFO>) {
 
     next if ($bin =~ m,^/usr/lib/debug/,);
 
-    my $dir = $bin;
-    $dir =~ s,/[^/]+?$,,;
+    my $elfdir = $bin;
+    $elfdir =~ s,/[^/]+?$,,;
 
-    Lintian::Command::Simple::run('mkdir', '-p', "strings/$dir") == 0
-        or fail("Failed to create directory 'strings/$dir'\n");
+    Lintian::Command::Simple::run ('mkdir', '-p', "$dir/strings/$elfdir") == 0
+        or fail "Failed to create directory 'strings/$elfdir'";
 
-    spawn({out => "strings/$bin", fail => 'error'}, ['strings', "unpacked/$bin"]);
+    spawn ({out => "$dir/strings/$bin", fail => 'error'}, ['strings', "$dir/unpacked/$bin"]);
 }
 
 close(ELF_INDEX) or fail("cannot write elf-index file: $!");
diff --git a/collection/unpacked b/collection/unpacked
index bf49c53..9b361d6 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -27,17 +27,15 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
 use Lintian::Command qw(spawn);
 use Util;
 
-($#ARGV == 1) or fail('syntax: unpacked <package> <type>');
+($#ARGV == 2) or fail('syntax: unpacked <package> <type> <dir>');
+my ($pkg, $type, $dir) = @ARGV;
 
-my $pkg = shift;
-my $type = shift;
-
-if (-d 'unpacked/') {
-    delete_dir('unpacked/') or
+if (-d "$dir/unpacked/") {
+    delete_dir ("$dir/unpacked/") or
         fail("failed to remove unpacked directory of $pkg");
 }
-if (-f 'unpacked-errors') {
-    unlink('unpacked-errors') or
+if (-f "$dir/unpacked-errors") {
+    unlink ("$dir/unpacked-errors") or
         fail("failed to remove unpacked-errors file of $pkg");
 }
 # If we are asked to only remove the files stop right here
@@ -49,12 +47,12 @@ if ($type eq 'source') {
     if (can_use_dpkg_source()) {
         # Ignore STDOUT of the child process because older versions of
         # dpkg-source print things out even with -q.
-        my $opts = { out => '/dev/null', err => 'unpacked-errors' };
+        my $opts = { out => '/dev/null', err => "$dir/unpacked-errors" };
         my @args = ('-q');
         push @args, '--no-check' if $ENV{'LINTIAN_COLL_UNPACKED_SKIP_SIG'};
         print "N: Using dpkg-source to unpack $pkg\n" if $ENV{'LINTIAN_DEBUG'};
-        unless (spawn($opts, ['dpkg-source', @args, '-x', 'dsc', 'unpacked'])) {
-            open(ERRORS, '<', 'unpacked-errors')
+        unless (spawn ($opts, ['dpkg-source', @args, '-x', "$dir/dsc", "$dir/unpacked"])) {
+            open ERRORS, '<', "$dir/unpacked-errors"
                 or fail("cannot open unpacked-errors: $!");
             print STDERR while <ERRORS>;
             close ERRORS;
@@ -62,26 +60,26 @@ if ($type eq 'source') {
         }
     } else {
         print "N: Using libdpkg-perl to unpack $pkg\n" if $ENV{'LINTIAN_DEBUG'};
-        libdpkg_unpack_dsc('dsc', 'unpacked');
+        libdpkg_unpack_dsc("$dir/dsc", "$dir/unpacked");
     }
 
     # fix permissions
     spawn({ fail => 'error' },
-          ['chmod', '-R', 'u+rwX,o+rX,o-w', 'unpacked']);
+          ['chmod', '-R', 'u+rwX,o+rX,o-w', "$dir/unpacked"]);
 
 } else {
-    mkdir('unpacked', 0777) or fail("mkdir unpacked: $!");
+    mkdir ("$dir/unpacked", 0777) or fail "mkdir unpacked: $!";
 
     # avoid using dpkg-deb -x; this pipeline is far faster.  I got a factor 2
     # improvement on large debs, and factor 1.5 on small debs.
     # I heard it's because dpkg-deb syncs while writing.  -- Richard
 
-    my $opts = { err => 'unpacked-errors' };
+    my $opts = { err => "$dir/unpacked-errors" };
     spawn($opts,
-            ['dpkg-deb', '--fsys-tarfile', 'deb'],
-            '|', ['tar', 'xf', '-', '-C', 'unpacked']);
+            ['dpkg-deb', '--fsys-tarfile', "$dir/deb"],
+            '|', ['tar', 'xf', '-', '-C', "$dir/unpacked"]);
     unless ($opts->{success}) {
-        open(ERRORS, '<', 'unpacked-errors')
+        open ERRORS, '<', "$dir/unpacked-errors"
             or fail("cannot open unpacked-errors: $!");
         print STDERR while <ERRORS>;
         close ERRORS;
@@ -90,7 +88,7 @@ if ($type eq 'source') {
 
     # fix permissions
     spawn({ fail => 'error' },
-            ['chmod', '-R', 'u+rwX,go-w', 'unpacked']);
+            ['chmod', '-R', 'u+rwX,go-w', "$dir/unpacked"]);
 }
 
 sub libdpkg_unpack_dsc {
diff --git a/debian/changelog b/debian/changelog
index 7e56eb1..20d7c60 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -19,12 +19,18 @@ lintian (2.5.6) UNRELEASED; urgency=low
     + [NT] Added trailing slash to copyright-format URLs in tag
       descriptions for consistency with the policy.
 
+  * collection/*:
+    + [NT] Removed assumption that "cwd" is the same as the
+      directory for the package being examined.
   * collection/java-info:
     + [NT] Added missing "use Util".
   * collection/scripts:
     + [NT] Use "fail" from Util.pm rather than using an embedded
       copy.
 
+  * frontend/lintian:
+    + [NT] Pass directory of the package to the collections.
+
   * lib/Lintian/Tag/Info.pm:
     + [NT] Fixed issue where "Experimental: no" was handled as a
       "yes" when generating a tag description.
diff --git a/frontend/lintian b/frontend/lintian
index cb666c5..ee480f6 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -1273,7 +1273,7 @@ sub auto_clean_package {
             next unless $lpkg->is_coll_finished ($coll, $ci->{'version'});
             my $script = "$opt{'LINTIAN_ROOT'}/collection/$ci->{'script'}";
             debug_msg(1, "Auto removing: $ci->{'script'} ...");
-            unless (Lintian::Command::Simple::rundir($base, $script, $pkg_name, "remove-${pkg_type}") == 0) {
+            unless (Lintian::Command::Simple::run ($script, $pkg_name, "remove-${pkg_type}", $base) == 0) {
                 warning("removing collect info $coll about package $pkg_name failed",
                         "skipping cleanup of $pkg_type package $pkg_name");
                 return 0;
@@ -1393,7 +1393,7 @@ sub unpack_group {
                 debug_msg(1, "Collecting info: $coll ...");
                 my $script = "$opt{'LINTIAN_ROOT'}/collection/$ci->{'script'}";
                 my $cmd = Lintian::Command::Simple->new();
-                unless ($cmd->background_dir($base, $script, $pkg_name, $pkg_type) > 0) {
+                unless ($cmd->background ($script, $pkg_name, $pkg_type, $base) > 0) {
                     warning("collect info $coll about package $pkg_name failed",
                             "skipping $action of $pkg_type package $pkg_name");
                     $exit_code = 2;
diff --git a/t/scripts/unpack-level.t b/t/scripts/unpack-level.t
index 8d215cc..62bf298 100755
--- a/t/scripts/unpack-level.t
+++ b/t/scripts/unpack-level.t
@@ -31,7 +31,7 @@ my @l2refs = (
         qr|->unpacked|,
 	qr<unpacked/>,
 	qr<unpacked-errors>,
-	qr<chdir\s*\(\s*["']unpacked/?['"]\s*\)>,
+	qr<chdir\s*\(\s*["'](?:\$dir/)?unpacked/?['"]\s*\)>,
 );
 
 # For each desc file, load the first stanza of the file and check that if

-- 
Debian package checker


Reply to: