[SCM] Debian package checker branch, master, updated. 2.4.3-174-g6c40856
The following commit has been merged in the master branch:
commit 6c40856bc91782e9ffe503436988a48cf0a8899d
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jan 26 12:43:22 2011 +0100
Fixed most of all PerlCritic warnings in unpack/
diff --git a/unpack/list-binpkg b/unpack/list-binpkg
index 0ccd7f2..0d15ef3 100755
--- a/unpack/list-binpkg
+++ b/unpack/list-binpkg
@@ -20,6 +20,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Relation::Version qw(versions_lte);
@@ -29,9 +30,9 @@ $| = 1;
# parse command line options
if ($#ARGV == -1) {
- print "list-binpkg [-v] <output-list-file>\n";
- print "options:\n";
- print " -v verbose\n";
+ print 'list-binpkg [-v] <output-list-file>\n';
+ print 'options:\n';
+ print ' -v verbose\n';
exit 0;
}
@@ -228,7 +229,7 @@ sub safe_get_deb_info {
# error!
print STDERR "$@\n";
print "E: general: bad-binary-package $_[0]\n";
- return undef;
+ return;
}
$data->{'source'} or ($data->{'source'} = $data->{'package'});
return $data;
diff --git a/unpack/list-srcpkg b/unpack/list-srcpkg
index cfe2ce1..738963d 100755
--- a/unpack/list-srcpkg
+++ b/unpack/list-srcpkg
@@ -20,6 +20,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Relation::Version qw(versions_lte);
@@ -91,7 +92,7 @@ foreach my $area (split /\s*,\s*/,$LINTIAN_AREA) {
$hash{'dist'} = $LINTIAN_DIST;
$hash{'area'} = $area;
$hash{'file'} = "$LINTIAN_ARCHIVEDIR/dists/$hash{'dist'}/$hash{'area'}/" .
- "source/Sources.gz";
+ 'source/Sources.gz';
push @sources, \%hash;
}
@@ -158,7 +159,7 @@ foreach my $sources (@sources) {
push(@f,$t[2]);
}
$data->{'files'} = join(',',@f);
- $data->{'standards-version'} ||= "";
+ $data->{'standards-version'} ||= '';
$pkg = $data->{'source'};
}
diff --git a/unpack/list-udebpkg b/unpack/list-udebpkg
index 3de3f00..b97d197 100755
--- a/unpack/list-udebpkg
+++ b/unpack/list-udebpkg
@@ -21,6 +21,7 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Relation::Version qw(versions_lte);
@@ -225,7 +226,7 @@ sub safe_get_deb_info {
# error!
print STDERR "$@\n";
print "E: general: bad-udeb-package $_[0]\n";
- return undef;
+ return;
}
$data->{'source'} or ($data->{'source'} = $data->{'package'});
return $data;
diff --git a/unpack/unpack-binpkg-l1 b/unpack/unpack-binpkg-l1
index 7123481..639d56d 100755
--- a/unpack/unpack-binpkg-l1
+++ b/unpack/unpack-binpkg-l1
@@ -24,9 +24,10 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use vars qw($verbose);
-($#ARGV == 1) or die "syntax: unpack-binpkg-l1 <base-dir> <deb-file>";
+($#ARGV == 1) or die 'syntax: unpack-binpkg-l1 <base-dir> <deb-file>';
my $base_dir = shift;
my $file = shift;
@@ -59,7 +60,7 @@ $job = { fail => 'error', err => "$base_dir/control-errors" };
push @jobs, $job;
# extract the tarball's contents
spawn($job,
- ["tar", "xf", "$base_dir/control.tar", "-C", "$base_dir/control", '&']);
+ ['tar', 'xf', "$base_dir/control.tar", '-C', "$base_dir/control", '&']);
$job = { fail => 'error',
out => "$base_dir/control-index",
@@ -67,8 +68,8 @@ $job = { fail => 'error',
push @jobs, $job;
# create index of control.tar.gz
spawn($job,
- ["tar", "tvf", "$base_dir/control.tar"],
- '|', ["sort", "-k", "6"], '&');
+ ['tar', 'tvf', "$base_dir/control.tar"],
+ '|', ['sort', '-k', '6'], '&');
reap(@jobs);
undef @jobs;
@@ -77,7 +78,7 @@ unlink("$base_dir/control.tar") or fail();
# fix permissions
spawn({ fail => 'error' },
- ["chmod", "-R", "u+rX,o-w", "$base_dir/control"]);
+ ['chmod', '-R', 'u+rX,o-w', "$base_dir/control"]);
$job = { fail => 'error',
out => "$base_dir/index",
@@ -86,10 +87,10 @@ push @jobs, $job;
# (replaces dpkg-deb -c)
# create index file for package
spawn($job,
- ["dpkg-deb", "--fsys-tarfile", $file ],
- '|', ["tar", "tfv", "-"],
- '|', ["sed", "-e", "s/^h/-/"],
- '|', ["sort", "-k", "6"], '&');
+ ['dpkg-deb', '--fsys-tarfile', $file ],
+ '|', ['tar', 'tfv', '-'],
+ '|', ['sed', '-e', 's/^h/-/'],
+ '|', ['sort', '-k', '6'], '&');
$job = { fail => 'error',
out => "$base_dir/index-owner-id",
@@ -98,10 +99,10 @@ push @jobs, $job;
# (replaces dpkg-deb -c)
# create index file for package with owner IDs instead of names
spawn($job,
- ["dpkg-deb", "--fsys-tarfile", $file],
- '|', ["tar", "--numeric-owner", "-tvf", "-"],
- '|', ["sed", "-e", "s/^h/-/"],
- '|', ["sort", "-k", "6"], '&');
+ ['dpkg-deb', '--fsys-tarfile', $file],
+ '|', ['tar', '--numeric-owner', '-tvf', '-'],
+ '|', ['sed', '-e', 's/^h/-/'],
+ '|', ['sort', '-k', '6'], '&');
# get package control information
my $data = (read_dpkg_control("$base_dir/control/control"))[0];
@@ -114,7 +115,7 @@ for my $field (keys %$data) {
$field =~ s,/,:,g;
my $field_file = "$base_dir/fields/$field";
open(F, '>', $field_file) or fail("cannot open file $field_file for writing: $!");
- print F $value,"\n";
+ print F $value,'\n';
close(F);
}
diff --git a/unpack/unpack-changes-l1 b/unpack/unpack-changes-l1
index 7d777bc..6520761 100755
--- a/unpack/unpack-changes-l1
+++ b/unpack/unpack-changes-l1
@@ -25,9 +25,10 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use vars qw($verbose);
-($#ARGV == 1) or die "syntax: unpack-changes-l1 <base-dir> <changes-file>";
+($#ARGV == 1) or die 'syntax: unpack-changes-l1 <base-dir> <changes-file>';
my $base_dir = shift;
my $file = shift;
@@ -54,7 +55,7 @@ for my $field (keys %$data) {
my $field_file = "$base_dir/fields/$field";
open(F, '>', $field_file)
or fail("cannot open file $field_file for writing: $!");
- print F $value,"\n";
+ print F $value,'\n';
close(F);
}
diff --git a/unpack/unpack-srcpkg-l1 b/unpack/unpack-srcpkg-l1
index 3046035..20148bd 100755
--- a/unpack/unpack-srcpkg-l1
+++ b/unpack/unpack-srcpkg-l1
@@ -26,9 +26,10 @@
# MA 02110-1301, USA.
use strict;
+use warnings;
use vars qw($verbose);
-($#ARGV == 1) or die "syntax: unpack-srcpkg-l1 <base-dir> <dsc-file>";
+($#ARGV == 1) or die 'syntax: unpack-srcpkg-l1 <base-dir> <dsc-file>';
my $base_dir = shift;
my $file = shift;
@@ -58,7 +59,7 @@ for my $field (keys %$data) {
my $field_file = "$base_dir/fields/$field";
open(F, '>', $field_file)
or fail("cannot open file $field_file for writing: $!");
- print F $value,"\n";
+ print F $value,'\n';
close(F);
}
@@ -76,7 +77,7 @@ symlink($file,"$base_dir/dsc") or fail("cannot symlink dsc file: $!");
my $tarball;
for my $fs (split(/\n/,$data->{'files'})) {
$fs =~ s/^\s*//;
- next if $fs =~ /^$/o;
+ next if $fs eq '';
my @t = split(/\s+/o,$fs);
next if ($t[2] =~ m,/,);
if ($t[2] =~ /^(\Q$base\E\.orig|\Q$baserev\E)\.tar\.(gz|bz2|lzma|xz)$/) {
@@ -86,7 +87,7 @@ for my $fs (split(/\n/,$data->{'files'})) {
or fail("cannot symlink file $t[2]: $!");
}
if (!$tarball) {
- fail("could not find the source tarball");
+ fail('could not find the source tarball');
}
# Collect a list of the files in the source package. tar currently doesn't
@@ -96,12 +97,12 @@ if (!$tarball) {
# don't parallelize this job because we need to use the output below.
my @tar_options = ('-tvf');
if ($tarball =~ /\.(lzma|xz)\z/) {
- unshift(@tar_options, "--$1");
+ unshift(@tar_options, '--$1');
}
my @index;
my $last = '';
my $collect = sub {
- my @lines = map { split "\n" } @_;
+ my @lines = map { split '\n' } @_;
if ($last ne '') {
$lines[0] = $last . $lines[0];
}
@@ -113,14 +114,14 @@ my $collect = sub {
for my $line (@lines) {
$line =~ s/^h/-/;
if ($line and $line !~ m,^(?:\S+\s+){5}\./$,) {
- push(@index, $line . "\n");
+ push(@index, $line . '\n');
}
}
};
spawn({ fail => 'never', out => $collect, err => "$base_dir/index-errors" },
- ["tar", @tar_options, "$base_dir/$tarball"]);
+ ['tar', @tar_options, "$base_dir/$tarball"]);
if ($last) {
- fail("tar output doesn't end in a newline");
+ fail('tar output does not end in a newline');
}
# We now need to see if all files in the tarball have a common prefix. If so,
@@ -128,15 +129,15 @@ if ($last) {
# that consist solely of the prefix.
my $prefix;
for my $line (@index) {
- my ($file) = ($line =~ /^(?:\S+\s+){5}(.*)/);
- $file =~ s,^\./+,,;
- my ($dir) = ($file =~ m,^([^/]+),);
- if (defined($dir) and $dir eq $file and not $line =~ /^d/) {
+ my ($filename) = ($line =~ /^(?:\S+\s+){5}(.*)/);
+ $filename =~ s,^\./+,,;
+ my ($dirname) = ($filename =~ m,^([^/]+),);
+ if (defined($dirname) and $dirname eq $filename and not $line =~ /^d/) {
$prefix = '';
- } elsif (defined $dir) {
+ } elsif (defined $dirname) {
if (not defined $prefix) {
- $prefix = $dir;
- } elsif ($dir ne $prefix) {
+ $prefix = $dirname;
+ } elsif ($dirname ne $prefix) {
$prefix = '';
}
} else {
--
Debian package checker
Reply to: