[SCM] Debian package checker branch, master, updated. 2.4.3-167-gc8f87a7
The following commit has been merged in the master branch:
commit 74b49227df4deadba781e6f7a14612143981e42a
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jan 26 10:28:28 2011 +0100
Fixed PerlCritic warnings in collection/
The remaining warnings about unused capture groups appears to be
false-positives (in file-info and md5sums).
diff --git a/collection/ar-info b/collection/ar-info
index f33f12e..5a32268 100755
--- a/collection/ar-info
+++ b/collection/ar-info
@@ -20,31 +20,32 @@
# MA 02110-1301, USA.
use strict;
-use lib "$ENV{LINTIAN_ROOT}/lib";
+use warnings;
+use lib "$ENV{LINTIAN_ROOT}/lib";
use FileHandle;
use Lintian::Command qw(spawn);
use Util qw(fail);
-($#ARGV == 1) or fail("syntax: ar-info <pkg> <type>");
+($#ARGV == 1) or fail('syntax: ar-info <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "fields/source" or fail("ar-info invoked in wrong directory");
+-f 'fields/source' or fail('ar-info invoked in wrong directory');
-unlink("ar-info");
-chdir("unpacked")
+unlink('ar-info');
+chdir('unpacked')
or fail("cannot chdir to unpacked directory: $!");
-open(INDEX, '<', "../index")
+open(INDEX, '<', '../index')
or fail("cannot open index file: $!");
-open(OUT, '>', "../ar-info")
+open(OUT, '>', '../ar-info')
or fail("cannot open ar-info file: $!");
while (<INDEX>) {
chomp;
next unless /\.a$/;
- my $file = (split(" ", $_, 6))[5];
+ my $file = (split(' ', $_, 6))[5];
next unless -f $file;
my $opts = { pipe_out => FileHandle->new, err => '/dev/null' };
spawn($opts, [ 'ar', 't', $file ]);
diff --git a/collection/changelog-file b/collection/changelog-file
index 2d66805..4a91518 100755
--- a/collection/changelog-file
+++ b/collection/changelog-file
@@ -20,6 +20,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
diff --git a/collection/copyright-file b/collection/copyright-file
index a968393..5a0e922 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -20,6 +20,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
diff --git a/collection/debfiles b/collection/debfiles
index 70475b8..59d4e31 100755
--- a/collection/debfiles
+++ b/collection/debfiles
@@ -20,21 +20,23 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
-($#ARGV == 1) or fail("syntax: debfiles <pkg> <type>");
-my $pkg = shift;
-my $type = shift;
-
--e "unpacked" or fail("debfiles invoked in wrong directory");
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-if (-e "debfiles") {
+($#ARGV == 1) or fail('syntax: debfiles <pkg> <type>');
+my $pkg = shift;
+my $type = shift;
+
+-e 'unpacked' or fail('debfiles invoked in wrong directory');
+
+if (-e 'debfiles') {
delete_dir('debfiles')
- or fail("cannot rm old debfiles directory");
+ or fail('cannot rm old debfiles directory');
}
# Copy the whole debian directory
-copy_dir("unpacked/debian/", "debfiles")
+copy_dir('unpacked/debian/', 'debfiles')
or fail("cannot copy unpacked/debian to debfiles: $!");
diff --git a/collection/debian-readme b/collection/debian-readme
index b82b555..5c4397d 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -20,17 +20,20 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail("syntax: debian-readme <pkg> <type>");
+($#ARGV == 1) or fail('syntax: debian-readme <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "fields/package" or fail("debian-readme invoked in wrong directory");
+-f 'fields/package' or fail('debian-readme invoked in wrong directory');
-unlink("README.Debian");
+if (-f 'README.Debian') {
+ unlink('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",
@@ -52,10 +55,10 @@ for (@readmes) {
if (not defined $file) {
# no README found
- touch_file("README.Debian");
+ touch_file('README.Debian');
} elsif ($file =~ m/\.gz$/) {
- gunzip_file($file, "README.Debian");
+ gunzip_file($file, 'README.Debian');
} else {
- link($file, "README.Debian")
+ link($file, 'README.Debian')
or fail("cannot link $file to README.Debian: $!");
}
diff --git a/collection/diffstat b/collection/diffstat
index 40ca984..b2121b2 100755
--- a/collection/diffstat
+++ b/collection/diffstat
@@ -26,16 +26,17 @@
# need be started.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail("syntax: diffstat <pkg>");
+($#ARGV == 1) or fail('syntax: diffstat <pkg> <type>');
my $pkg = shift;
--f "fields/version" or fail("diffstat invoked in wrong directory");
+-f 'fields/version' or fail('diffstat invoked in wrong directory');
-open (V, '<', "fields/version") or fail("cannot open fields/version: $!");
+open (V, '<', 'fields/version') or fail("cannot open fields/version: $!");
my $ver = <V>; chomp $ver;
close V;
@@ -51,12 +52,12 @@ unless (-f $diff_file) {
exit 0;
}
-gunzip_file($diff_file, "debian-patch");
+gunzip_file($diff_file, 'debian-patch');
-open (STAT, '>', "diffstat") or fail("cannot open scripts output file: $!");
+open (STAT, '>', '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 STDERR, '>', '/dev/null';
open (DIFF, '-|', qw/diffstat -p1 debian-patch/)
or fail("cannot open pipe to diffstat on debian-patch: $!");
# Copy all except last line to the STAT file
diff --git a/collection/doc-base-files b/collection/doc-base-files
index 3160286..5976ab2 100755
--- a/collection/doc-base-files
+++ b/collection/doc-base-files
@@ -21,25 +21,27 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
-($#ARGV == 1) or fail("syntax: doc-base-files <pkg> <type>");
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+
+($#ARGV == 1) or fail('syntax: doc-base-files <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "fields/package" or fail("doc-base-files invoked in wrong directory");
+-f 'fields/package' or fail('doc-base-files invoked in wrong directory');
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Util;
-if (-e "doc-base") {
- delete_dir("doc-base")
- or fail("cannot rm old doc-base directory");
+if (-e 'doc-base') {
+ delete_dir('doc-base')
+ or fail('cannot rm old doc-base directory');
}
-if (-d "unpacked/usr/share/doc-base") {
+if (-d 'unpacked/usr/share/doc-base') {
copy_dir('unpacked/usr/share/doc-base', 'doc-base')
- or fail("cannot copy directory unpacked/usr/share/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('doc-base', 0777) or fail("cannot mkdir doc-base: $!");
}
diff --git a/collection/file-info b/collection/file-info
index 903b2ad..2dbc1a7 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -46,7 +46,7 @@ my %opts = ( pipe_in => FileHandle->new,
fail => 'never' );
spawn(\%opts, ['xargs', '-0r', 'file', '-F', '', '--print0', '--']);
$opts{pipe_in}->blocking(1);
-open(INDEX, '<', "../index")
+open(INDEX, '<', '../index')
or fail("cannot open index file: $!");
while (<INDEX>) {
chomp;
diff --git a/collection/init.d b/collection/init.d
index 16f7cf9..fa0d8ef 100755
--- a/collection/init.d
+++ b/collection/init.d
@@ -20,25 +20,26 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
-($#ARGV == 1) or fail("syntax: init.d <pkg> <type>");
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+
+($#ARGV == 1) or fail('syntax: init.d <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "fields/package" or fail("init.d invoked in wrong directory");
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Util;
+-f 'fields/package' or fail('init.d invoked in wrong directory');
-if (-e "init.d") {
- delete_dir("init.d")
- or fail("cannot rm old init.d directory");
+if (-e 'init.d') {
+ delete_dir('init.d')
+ or fail('cannot rm old init.d directory');
}
-if (-d "unpacked/etc/init.d") {
+if (-d 'unpacked/etc/init.d') {
copy_dir('unpacked/etc/init.d', 'init.d')
- or fail("cannot copy init.d directory");
+ or fail('cannot copy init.d directory');
} else {
# no etc/init.d
- mkdir("init.d", 0777) or fail("cannot mkdir init.d: $!");
+ mkdir('init.d', 0777) or fail("cannot mkdir init.d: $!");
}
diff --git a/collection/md5sums b/collection/md5sums
index d892357..e513d63 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -20,6 +20,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
diff --git a/collection/menu-files b/collection/menu-files
index d48aa4a..aa2a0a2 100755
--- a/collection/menu-files
+++ b/collection/menu-files
@@ -20,22 +20,23 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
-($#ARGV == 1) or fail("syntax: menu-files <pkg> <type>");
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+
+($#ARGV == 1) or fail('syntax: menu-files <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "fields/package" or fail("menu-files invoked in wrong directory");
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Util;
+-f 'fields/package' or fail('menu-files invoked in wrong directory');
-if (-e "menu") {
+if (-e 'menu') {
delete_dir('menu')
- or fail("cannot rm old menu directory");
+ or fail('cannot rm old menu directory');
}
-mkdir("menu", 0777) or fail("cannot mkdir menu: $!");
+mkdir('menu', 0777) or fail("cannot mkdir menu: $!");
my %dirs;
$dirs{'share'} = 'usr/share/menu';
diff --git a/collection/objdump-info b/collection/objdump-info
index 7b3e663..cfa681e 100755
--- a/collection/objdump-info
+++ b/collection/objdump-info
@@ -24,19 +24,20 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
# Sanity check
-unless (-f "fields/package") {
- print STDERR "error: collection script called in wrong directory!\n";
+unless (-f 'fields/package') {
+ print STDERR 'error: collection script called in wrong directory!\n';
exit 2;
}
my $failed = 0;
-open (FILES, '<', "file-info")
+open (FILES, '<', 'file-info')
or fail("cannot open file-info: $!");
-open (OUT, '>', "objdump-info")
+open (OUT, '>', 'objdump-info')
or fail("cannot open objdump-info: $!");
# Disable etch compatibility code.
@@ -44,7 +45,7 @@ open (OUT, '>', "objdump-info")
# readelf code is not dropped as per private/TODO entry
my $etch_compat = 0;
-chdir ("unpacked")
+chdir ('unpacked')
or fail ("unable to chdir to unpacked: $!\n");
while (<FILES>) {
@@ -93,7 +94,7 @@ while (<FILES>) {
last if $failed;
- if ($invalidop or !$etch_compat) {
+ if ($invalidop || !$etch_compat) {
# If we're using a binutils newer than etch's then either
# "invalid operation" or "file format not recognized"
# are simply passed through to the checks scripts
@@ -157,9 +158,9 @@ while (<FILES>) {
$value =~ s/^(?:Shared library|Library soname): \[(.*)\]/$1/;
print OUT " $type $value\n";
- } elsif (m/^\s*[0-9A-F]+:\s+(\S+)\s*(?:\((\S+)\))?(\s|\Z)/i
+ } elsif (m/^\s*[0-9A-F]+: \s+ \S+ \s* (?:\(\S+\))? (?:\s|\Z)/i
and $section eq 'VS') {
- while (m/([0-9A-F]+h?)\s*(?:\((\S+)\))?(\s|\Z)/gci) {
+ while (m/([0-9A-F]+h?)\s*(?:\((\S+)\))?(?:\s|\Z)/gci) {
my ($vernum, $verstring) = ($1, $2);
$verstring ||= '';
if ($vernum =~ m/h$/) {
diff --git a/collection/override-file b/collection/override-file
index 812fee4..729cf4c 100755
--- a/collection/override-file
+++ b/collection/override-file
@@ -21,17 +21,20 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
-($#ARGV == 1) or fail("syntax: override-file <pkg> <type>");
+($#ARGV == 1) or fail('syntax: override-file <pkg> <type>');
my $pkg = shift;
my $type = shift;
--d "unpacked" or fail("override-file invoked in wrong directory");
+-d 'unpacked' or fail('override-file invoked in wrong directory');
-unlink("override");
+if (-e 'override'){
+ unlink('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.
@@ -53,9 +56,9 @@ for my $override (@overrides) {
if (not defined $file) {
# no override found
} elsif ($file =~ /\.gz$/) {
- gunzip_file($file, "override");
+ gunzip_file($file, 'override');
} else {
- link($file, "override")
+ link($file, 'override')
or fail("cannot link $file to override: $!");
}
diff --git a/collection/scripts b/collection/scripts
index cfe228c..f4a6b3f 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -20,9 +20,10 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
-open(SCRIPTS, '>', "scripts") or fail("cannot open scripts output file: $!");
-open(INDEX, '<', "index") or fail("cannot open index file: $!");
+open(SCRIPTS, '>', 'scripts') or fail("cannot open scripts output file: $!");
+open(INDEX, '<', 'index') or fail("cannot open index file: $!");
my $file;
my $magic;
@@ -66,10 +67,10 @@ while (<INDEX>) {
close(INDEX);
close(SCRIPTS) or fail("cannot write scripts file: $!");
-open(SCRIPTS, '>', "control-scripts")
+open(SCRIPTS, '>', 'control-scripts')
or fail("cannot open control-scripts output file: $!");
-opendir(CONTROL, "control")
+opendir(CONTROL, 'control')
or fail("cannot read control directory: $!");
for $file (readdir CONTROL) {
diff --git a/collection/source-control-file b/collection/source-control-file
index 619f9cb..eced0b2 100755
--- a/collection/source-control-file
+++ b/collection/source-control-file
@@ -22,20 +22,20 @@
use strict;
use warnings;
-($#ARGV == 1) or fail("syntax: source-control-file <pkg> <type>");
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+
+($#ARGV == 1) or fail('syntax: source-control-file <pkg> <type>');
my $pkg = shift;
my $type = shift;
--f "debfiles/control" or fail("control invoked in wrong directory");
-
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Util;
+-f 'debfiles/control' or fail('control invoked in wrong directory');
-my @control_data = read_dpkg_control("debfiles/control");
+my @control_data = read_dpkg_control('debfiles/control');
shift @control_data; # we don't need the source information
delete_dir('control');
-mkdir "control", 0777 or fail( "can't create dir control: $!" );
+mkdir 'control', 0777 or fail( "can't create dir control: $!" );
foreach (@control_data) {
my $pkg_name = $_->{'package'};
diff --git a/collection/strings b/collection/strings
index 29e7b86..22de466 100755
--- a/collection/strings
+++ b/collection/strings
@@ -27,13 +27,13 @@ use Util;
use Lintian::Command qw(spawn);
use Lintian::Command::Simple;
-($#ARGV == 1) or fail("syntax: strings <pkg> <type>");
+($#ARGV == 1) or fail('syntax: strings <pkg> <type>');
--f "file-info"
- or fail("file-info invoked in wrong directory");
+-f 'file-info'
+ or fail('file-info invoked in wrong directory');
-unlink("elf-index");
-delete_dir("strings");
+unlink('elf-index');
+delete_dir('strings');
open(ELF_INDEX, '>', 'elf-index')
or fail("Could not open 'elf-index' for writing: $!\n");
diff --git a/collection/unpacked b/collection/unpacked
index 1085f3c..1cceb5a 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -22,23 +22,22 @@
use strict;
use warnings;
-use vars qw($verbose);
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn);
use Util;
-($#ARGV == 1) or fail("syntax: unpacked <package> <type>");
+($#ARGV == 1) or fail('syntax: unpacked <package> <type>');
my $pkg = shift;
my $type = shift;
-if (-d "unpacked/") {
- delete_dir("unpacked/") or
+if (-d 'unpacked/') {
+ delete_dir('unpacked/') or
fail("failed to remove unpacked directory of $pkg");
}
-if (-f "unpacked-errors") {
- unlink("unpacked-errors") or
+if (-f 'unpacked-errors') {
+ unlink('unpacked-errors') or
fail("failed to remove unpacked-errors file of $pkg");
}
# If we are asked to only remove the files stop right here
@@ -46,7 +45,7 @@ if ($type =~ m/^remove-/) {
exit 0;
}
-if ($type eq "source") {
+if ($type eq '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' };
@@ -55,34 +54,34 @@ if ($type eq "source") {
or fail("cannot open unpacked-errors: $!");
print STDERR while <ERRORS>;
close ERRORS;
- fail("dpkg-source -x failed with status ", $opts->{harness}->result);
+ fail('dpkg-source -x failed with status ', $opts->{harness}->result);
}
-
+
# fix permissions
spawn({ fail => 'error' },
['chmod', '-R', 'u+rwX,o+rX,o-w', 'unpacked']);
} else {
- mkdir("unpacked", 0777) or fail("mkdir unpacked: $!");
+ mkdir('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 => 'unpacked-errors' };
spawn($opts,
- ['dpkg-deb', '--fsys-tarfile', "deb"],
- '|', ['tar', 'xf', '-', '-C', "unpacked"]);
+ ['dpkg-deb', '--fsys-tarfile', 'deb'],
+ '|', ['tar', 'xf', '-', '-C', 'unpacked']);
unless ($opts->{success}) {
- open(ERRORS, '<', "unpacked-errors")
+ open(ERRORS, '<', 'unpacked-errors')
or fail("cannot open unpacked-errors: $!");
print STDERR while <ERRORS>;
close ERRORS;
- fail("dpkg-deb | tar failed with status ", $opts->{harness}->result);
+ fail('dpkg-deb | tar failed with status ', $opts->{harness}->result);
}
# fix permissions
spawn({ fail => 'error' },
- ['chmod', '-R', 'u+rwX,go-w', "unpacked"]);
+ ['chmod', '-R', 'u+rwX,go-w', 'unpacked']);
}
--
Debian package checker
Reply to: