[SCM] Debian package checker branch, master, updated. 2.5.1-86-gf268644
The following commit has been merged in the master branch:
commit f268644b7c38fe96ce89be9aae8e867be1f1bad2
Author: Niels Thykier <niels@thykier.net>
Date: Tue Jul 12 19:35:24 2011 +0200
Refactored Read_pkglists and the parts using it
Read_pkglists no longer relies on global variables, in which to store
the results. Instead, it will generate a new hash each time it is
called and return the ref to it.
This allows for the removal of a couple of:
# no clue why this is here
use vars qw(...) # from the above
It also no longer falls back to the info files in the Lab, so files
have to be passed explicitly now. Nor does it accept the $quiet
parameter anymore that as a side effect completely changed the
error handling.
This means that frontend/lintian will now terminate if one of the
files cannot be read instead of continuing and failing with a
"Cannot find package XYZ in dist or lab".
The list-{bin,src,udeb}pkg scripts will happily ignore the contents of
the packages file if it cannot be read or the format is not
compatiable. If only because this is what they used to do...
diff --git a/frontend/lintian b/frontend/lintian
index 20fe34d..cff2553 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -44,7 +44,7 @@ use Getopt::Long;
#
# LINTIAN_{ARCH,ARCHIVEDIR,AREA,DIST,LAB,ROOT}
# - These must be exported as environment variables as unpack/*
-# and Read_pkglists depend on it.
+# depend on it.
#
# Please do not introduce any new magical variables, Thank You!
#
@@ -808,11 +808,8 @@ if ($opt{'LINTIAN_PROFILE'}) {
# }}}
-# {{{ No clue why this code is here...
+# {{{ Set up clean-up handlers.
-use vars qw(%source_info %binary_info %udeb_info); # from the above
-
-# Set up clean-up handlers.
$SIG{'INT'} = \&interrupted;
$SIG{'QUIT'} = \&interrupted;
@@ -868,6 +865,11 @@ $ENV{'LINTIAN_LAB'} = $opt{'LINTIAN_LAB'} = $LAB->{dir};
$pool = Lintian::ProcessablePool->new();
# process package/file arguments
+
+# Store contents of the packages files in these if needed
+my ($src_info, $bin_info, $udeb_info);
+
+
while (my $arg = shift) {
# file?
if (-f $arg) {
@@ -891,26 +893,25 @@ while (my $arg = shift) {
my $found = 0;
- # read package info
- read_src_list("$opt{'LINTIAN_LAB'}/info/source-packages", 0);
- read_bin_list("$opt{'LINTIAN_LAB'}/info/binary-packages", 0);
- read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages", 0);
-
if (($pkg_mode eq 'b') or ($pkg_mode eq 'a')) {
- if ($binary_info{$arg}) {
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$binary_info{$arg}->{'file'}");
+ $bin_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/binary-packages") unless $bin_info;
+ if ($bin_info->{$arg}) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->{$arg}->{'file'});
$found = 1;
}
}
if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
- if ($udeb_info{$arg}) {
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$udeb_info{$arg}->{'file'}");
+ $udeb_info = read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
+ if ($udeb_info->{$arg}) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->{$arg}->{'file'});
$found = 1;
}
}
if (($pkg_mode eq 's') or ($pkg_mode eq 'a')) {
- if ($source_info{$arg}) {
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$source_info{$arg}->{'file'}");
+ $src_info = read_src_list("$opt{'LINTIAN_LAB'}/info/source-packages") unless $src_info;
+
+ if ($src_info->{$arg}) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->{$arg}->{'file'});
$found = 1;
}
}
@@ -966,28 +967,28 @@ while (my $arg = shift) {
if ($check_everything) {
# make sure package info is available
- read_src_list("$opt{'LINTIAN_LAB'}/info/source-packages", 0);
- read_bin_list("$opt{'LINTIAN_LAB'}/info/binary-packages", 0);
- read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages", 0);
+ $src_info = read_src_list("$opt{'LINTIAN_LAB'}/info/source-packages") unless $src_info;
+ $bin_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/binary-packages") unless $bin_info;
+ $udeb_info = read_udeb_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
debug_msg(2, "pkg_mode = $pkg_mode");
if (($pkg_mode eq 'a') or ($pkg_mode eq 's')) {
- for my $arg (sort keys %source_info) {
- debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/$source_info{$arg}->{'file'}");
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$source_info{$arg}->{'file'}");
+ for my $arg (sort keys %$src_info) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->{$arg}->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->{$arg}->{'file'});
}
}
if (($pkg_mode eq 'a') or ($pkg_mode eq 'b')) {
- for my $arg (sort keys %binary_info) {
- debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/$binary_info{$arg}->{'file'}");
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$binary_info{$arg}->{'file'}");
+ for my $arg (sort keys %$bin_info) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->{$arg}->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->{$arg}->{'file'});
}
}
if (($pkg_mode eq 'a') or ($pkg_mode eq 'u')) {
- for my $arg (sort keys %udeb_info) {
- debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/$udeb_info{$arg}->{'file'}");
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/$udeb_info{$arg}->{'file'}");
+ for my $arg (sort keys %$udeb_info) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->{$arg}->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->{$arg}->{'file'});
}
}
} elsif ($packages_file) {
@@ -1000,6 +1001,13 @@ if ($check_everything) {
}
close($pkgin);
}
+
+# undef these as they are not needed any more and they give a cheap
+# extra 5+ MB of RAM back on lintian.d.o.
+undef $src_info;
+undef $bin_info;
+undef $udeb_info;
+
# }}}
# {{{ Some silent exit
diff --git a/lib/Read_pkglists.pm b/lib/Read_pkglists.pm
index b4e1f69..c318a7e 100644
--- a/lib/Read_pkglists.pm
+++ b/lib/Read_pkglists.pm
@@ -18,54 +18,51 @@
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
+package Read_pkglists;
use strict;
use warnings;
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Carp qw(croak);
use Util;
-
-use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT $UDEBLIST_FORMAT %source_info %binary_info %udeb_info %bin_src_ref);
+use base 'Exporter';
# these banner lines have to be changed with every incompatible change of the
# binary and source list file formats
-$BINLIST_FORMAT = "Lintian's list of binary packages in the archive--V4";
-$SRCLIST_FORMAT = "Lintian's list of source packages in the archive--V4";
-$UDEBLIST_FORMAT = "Lintian's list of udeb packages in the archive--V3";
-
-%source_info = ();
-%binary_info = ();
-%udeb_info = ();
-%bin_src_ref = ();
+use constant BINLIST_FORMAT => "Lintian's list of binary packages in the archive--V4";
+use constant SRCLIST_FORMAT => "Lintian's list of source packages in the archive--V4";
+use constant UDEBLIST_FORMAT => "Lintian's list of udeb packages in the archive--V3";
+
+our @EXPORT = (qw(
+ BINLIST_FORMAT
+ SRCLIST_FORMAT
+ UDEBLIST_FORMAT
+ read_src_list
+ read_bin_list
+ read_udeb_list
+));
sub read_src_list {
- my ($src_list,$quiet) = @_;
- my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-
- if (%source_info) {
- warn "\%source_info exists, nothing to do in read_src_list\n" unless $quiet;
- return;
- }
+ my ($src_list) = @_;
+ my %source_info;
- $src_list or ($src_list = "$LINTIAN_LAB/info/source-packages");
- return unless -s $src_list;
+ return {} unless $src_list && -s $src_list;
- open(IN, '<', $src_list) or fail("cannot open source list file $src_list: $!");
+ open my $IN, '<', $src_list or croak "open $src_list: $!";
# compatible file format?
my $f;
- chop($f = <IN>);
- if ($f ne $SRCLIST_FORMAT) {
- close(IN);
- return 0 if $quiet;
- fail("the source list file $src_list has an incompatible file format (run lintian --setup-lab)");
+ chop($f = <$IN>);
+ if ($f ne SRCLIST_FORMAT) {
+ close($IN);
+ croak "$src_list has an incompatible file format";
}
# compatible format, so read file
- while (<IN>) {
+ while (<$IN>) {
chop;
- next if /^\s*$/o;
- my ($src,$ver,$maint,$uploaders,$arch,$area,$std,$bin,$files,$file,$timestamp) = split(/\;/,$_);
+ next if m/^\s*$/o;
+ my ($src,$ver,$maint,$uploaders,$arch,$area,$std,$bin,$files,$file,$timestamp) = split(m/\;/o,$_);
my $src_struct;
%$src_struct =
@@ -86,38 +83,32 @@ sub read_src_list {
$source_info{$src} = $src_struct;
}
- close(IN);
+ close($IN);
+ return \%source_info;
}
sub read_bin_list {
- my ($bin_list,$quiet) = @_;
- my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-
- if (%binary_info) {
- warn "\%binary_info exists, nothing to do in read_bin_list\n" unless $quiet;
- return;
- }
+ my ($bin_list) = @_;
+ my %binary_info;
- $bin_list or ($bin_list = "$LINTIAN_LAB/info/binary-packages");
- return unless -s $bin_list;
+ return {} unless $bin_list && -s $bin_list;
- open(IN, '<', $bin_list) or fail("cannot open binary list file $bin_list: $!");
+ open(my $IN, '<', $bin_list) or fail("open $bin_list: $!");
# compatible file format?
my $f;
- chop($f = <IN>);
- if ($f ne $BINLIST_FORMAT) {
- close(IN);
- return 0 if $quiet;
- fail("the binary list file $bin_list has an incompatible file format (run lintian --setup-lab)");
+ chop($f = <$IN>);
+ if ($f ne BINLIST_FORMAT) {
+ close($IN);
+ croak "$bin_list has an incompatible file format";
}
# compatible format, so read file
- while (<IN>) {
+ while (<$IN>) {
chop;
- next if /^\s*$/o;
- my ($bin,$ver,$source,$source_ver,$file,$timestamp,$area) = split(/\;/o,$_);
+ next if m/^\s*$/o;
+ my ($bin,$ver,$source,$source_ver,$file,$timestamp,$area) = split(m/\;/o,$_);
my $bin_struct;
%$bin_struct =
@@ -134,38 +125,32 @@ sub read_bin_list {
$binary_info{$bin} = $bin_struct;
}
- close(IN);
+ close($IN);
+ return \%binary_info;
}
sub read_udeb_list {
- my ($udeb_list,$quiet) = @_;
- my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
+ my ($udeb_list) = @_;
+ my %udeb_info;
- if (%udeb_info) {
- warn "\%udeb_info exists, nothing to do in read_bin_list\n" unless $quiet;
- return;
- }
-
- $udeb_list or ($udeb_list = "$LINTIAN_LAB/info/udeb-packages");
- return unless -s $udeb_list;
+ return {} unless $udeb_list && -s $udeb_list;
- open(IN, '<', $udeb_list) or fail("cannot open udeb list file $udeb_list: $!");
+ open(my $IN, '<', $udeb_list) or croak("open $udeb_list: $!");
# compatible file format?
my $f;
- chop($f = <IN>);
- if ($f ne $UDEBLIST_FORMAT) {
- close(IN);
- return 0 if $quiet;
- fail("the udeb list file $udeb_list has an incompatible file format (run lintian --setup-lab)");
+ chop($f = <$IN>);
+ if ($f ne UDEBLIST_FORMAT) {
+ close($IN);
+ croak "$udeb_list has an incompatible file format";
}
# compatible format, so read file
- while (<IN>) {
+ while (<$IN>) {
chop;
- next if /^\s*$/o;
- my ($udeb,$ver,$source,$source_ver,$file,$timestamp,$area) = split(/\;/o,$_);
+ next if m/^\s*$/o;
+ my ($udeb,$ver,$source,$source_ver,$file,$timestamp,$area) = split(m/\;/o,$_);
my $udeb_struct;
%$udeb_struct =
@@ -182,20 +167,11 @@ sub read_udeb_list {
$udeb_info{$udeb} = $udeb_struct;
}
- close(IN);
+ close($IN);
+ return \%udeb_info;
}
-
-sub get_bin_src_ref {
- read_src_list();
- for my $source (keys %source_info) {
- for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
- $bin_src_ref{$binary} = $source;
- }
- }
-}
-
1;
# Local Variables:
diff --git a/reporting/harness b/reporting/harness
index a469d1e..191d9dd 100755
--- a/reporting/harness
+++ b/reporting/harness
@@ -64,7 +64,6 @@ use vars qw($LINTIAN_ROOT $LINTIAN_LAB $LINTIAN_ARCHIVEDIR $LINTIAN_DIST
# import perl libraries
unshift @INC, "$LINTIAN_ROOT/lib";
require Read_pkglists;
-use vars qw(%binary_info %source_info %udeb_info); # from the above
require Util;
# turn file buffering off
@@ -162,17 +161,17 @@ if ($opt_i) { # process changes only
# read binary packages files
$pkgfile = "$LINTIAN_LAB/info/binary-packages";
(-f $pkgfile) or Die("cannot find list of binary packages $pkgfile");
- read_bin_list($pkgfile);
+ my %binary_info = %{ read_bin_list($pkgfile) };
# read udeb packages files
$pkgfile = "$LINTIAN_LAB/info/udeb-packages";
(-f $pkgfile) or Die("cannot find list of udeb packages $pkgfile");
- read_udeb_list($pkgfile);
+ my %udeb_info = %{ read_udeb_list($pkgfile) };
# read source packages files
$pkgfile = "$LINTIAN_LAB/info/source-packages";
(-f $pkgfile) or Die("cannot find list of source packages $pkgfile");
- read_src_list($pkgfile);
+ my %source_info = %{ read_src_list($pkgfile) };
# process changes file and create list of packages to process
Log('Reading changes file...');
diff --git a/reporting/html_reports b/reporting/html_reports
index 8769fdc..61b4e9e 100755
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@ -63,10 +63,6 @@ use Read_pkglists;
use Text_utils;
use Util;
-# Global variables from Read_pkglists. Ugh.
-# FIXME: Read_pkglists should return this information instead.
-our (%binary_info, %source_info, %udeb_info, %bin_src_ref);
-
# Get additional tag information.
our %tag_extra = ();
@@ -117,11 +113,18 @@ for my $template (qw/head foot clean index maintainer maintainers packages tag
# Read the package lists.
#
-# FIXME: get_bin_src_ref runs read_src_list unconditionally so we can't call
-# it directly, which is confusing.
-read_bin_list;
-read_udeb_list;
-get_bin_src_ref;
+
+my %binary_info = %{ read_bin_list("$LINTIAN_LAB/info/binary-packages"); };
+my %udeb_info = %{ read_udeb_list("$LINTIAN_LAB/info/udeb-packages"); };
+my %source_info = %{ read_src_list("$LINTIAN_LAB/info/source-packages"); };
+my %bin_src_ref;
+
+for my $source (keys %source_info) {
+ for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
+ $bin_src_ref{$binary} = $source;
+ }
+}
+
# Create output directories.
mkdir($HTML_TMP_DIR, 0777)
diff --git a/unpack/list-binpkg b/unpack/list-binpkg
index 1a67337..79290ee 100755
--- a/unpack/list-binpkg
+++ b/unpack/list-binpkg
@@ -64,7 +64,6 @@ unless ($output_file) {
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Read_pkglists;
-use vars qw(%binary_info $BINLIST_FORMAT); # from the above
use Util;
# get variables out of environment
@@ -75,7 +74,11 @@ my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
# read old list file (this command does nothing if the file does not exist)
-read_bin_list($output_file,1);
+my $ref = {};
+# ignore the contents if the contents cannot be read - that is what we
+# used to do!
+eval { $ref = read_bin_list($output_file) };
+my %binary_info = %$ref;
my %pkgfile;
# map filenames to package names
@@ -86,7 +89,7 @@ for my $pkg (keys %binary_info) {
# open output file
open(OUT, '>', $output_file)
or fail("cannot open list file $output_file for writing: $!");
-print OUT "$BINLIST_FORMAT\n";
+print OUT Read_pkglists::BINLIST_FORMAT. "\n";
# parse Packages file to get list of packages
my @packages_files;
diff --git a/unpack/list-srcpkg b/unpack/list-srcpkg
index e437e9b..80c8f16 100755
--- a/unpack/list-srcpkg
+++ b/unpack/list-srcpkg
@@ -63,7 +63,6 @@ unless ($output_file) {
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Read_pkglists;
-use vars qw(%source_info $SRCLIST_FORMAT); # from the above
use Util;
# get variables out of environment
@@ -73,7 +72,11 @@ my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
# read old list file (this command does nothing if the file does not exist)
-read_src_list($output_file,1);
+my $ref = {};
+# ignore the contents if the contents cannot be read - that is what we
+# used to do!
+eval { $ref = read_src_list($output_file) };
+my %source_info = %$ref;
my %pkgfile;
# map filenames to package names
@@ -83,7 +86,7 @@ for my $pkg (keys %source_info) {
# open output file
open(OUT, '>', $output_file) or fail("cannot open list file $output_file for writing: $!");
-print OUT "$SRCLIST_FORMAT\n";
+print OUT Read_pkglists::SRCLIST_FORMAT ."\n";
# parse Sources.gz to get list of packages
my @sources;
diff --git a/unpack/list-udebpkg b/unpack/list-udebpkg
index b97d197..dcb97fd 100755
--- a/unpack/list-udebpkg
+++ b/unpack/list-udebpkg
@@ -65,7 +65,6 @@ unless ($output_file) {
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Read_pkglists;
-use vars qw(%udeb_info $UDEBLIST_FORMAT); # from the above
use Util;
# get variables out of environment
@@ -76,7 +75,11 @@ my $LINTIAN_AREA = $ENV{'LINTIAN_AREA'};
my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
# read old list file (this command does nothing if the file does not exist)
-read_udeb_list($output_file,1);
+my $ref = {};
+# ignore the contents if the contents cannot be read - that is what we
+# used to do!
+eval { $ref = read_udeb_list($output_file) };
+my %udeb_info = %$ref;
my %pkgfile;
# map filenames to package names
@@ -87,7 +90,7 @@ for my $pkg (keys %udeb_info) {
# open output file
open(OUT, '>', $output_file)
or fail("cannot open list file $output_file for writing: $!");
-print OUT "$UDEBLIST_FORMAT\n";
+print OUT Read_pkglists::UDEBLIST_FORMAT . "\n";
# parse Packages file to get list of packages
my @packages_files;
--
Debian package checker
Reply to: