[SCM] Debian package checker branch, lab-refactor, updated. 2.5.3-118-gb90ac70
The following commit has been merged in the lab-refactor branch:
commit b90ac70f93c1c5d79288f04dbfc985e7ef5d58ec
Merge: edad1ceef7c57e0fc46b3c050f818743dbb98b72 54e2e0258a5ada5fe6fd6ed21911e1bbdd698bb2
Author: Niels Thykier <niels@thykier.net>
Date: Sun Oct 9 18:27:18 2011 +0200
Merge branch 'master' into lab-refactor
diff --combined frontend/lintian
index f5a0f40,5eb785f..b1fcc1b
--- a/frontend/lintian
+++ b/frontend/lintian
@@@ -739,9 -739,12 +739,9 @@@ if (-d "$LINTIAN_ROOT/locale/en_US.UTF-
# {{{ Loading lintian's own libraries (now LINTIAN_ROOT is known)
unshift @INC, "$opt{'LINTIAN_ROOT'}/lib";
-require Lab;
+require Lintian::Lab;
require Util;
-require Read_pkglists;
-import Read_pkglists qw(read_bin_list read_src_list);
-
import Util;
require Checker;
@@@ -755,7 -758,6 +755,7 @@@ require Lintian::Command
import Lintian::Command qw(spawn reap);
require Lintian::Internal::FrontendUtil;
import Lintian::Internal::FrontendUtil;
+require Lintian::Internal::PackageList;
require Lintian::ProcessablePool;
require Lintian::Profile;
require Lintian::Tag::Info;
@@@ -867,7 -869,7 +867,7 @@@ $SIG{'QUIT'} = \&interrupted
# {{{ Create/Maintain Lab and add any specified Debian Archives (*.debs)
-$LAB = Lab->new( $opt{'LINTIAN_LAB'} );
+$LAB = Lintian::Lab->new( $opt{'LINTIAN_LAB'} );
#######################################
# Process -S option
@@@ -876,7 -878,7 +876,7 @@@ if ($action eq 'setup-lab')
warning('ignoring additional command line arguments');
}
- $LAB->setup_static()
+ $LAB->create_lab()
or fail('There was an error while setting up the static lab.');
exit 0;
@@@ -888,7 -890,7 +888,7 @@@
warning('ignoring additional command line arguments');
}
- $LAB->delete_static()
+ $LAB->remove_lab()
or fail('There was an error while removing the static lab.');
exit 0;
@@@ -900,19 -902,13 +900,19 @@@
fail("bad action $action specified");
}
-# sanity check:
-fail('lintian lab has not been set up correctly (perhaps you forgot to run lintian --setup-lab?)')
- unless $LAB->is_lab();
+if ($LAB->dir) {
+ # sanity check:
+ fail('lintian lab has not been set up correctly (perhaps you forgot to run lintian --setup-lab?)')
+ unless $LAB->lab_exists;
+} else {
+ $LAB->create_lab ( {'keep-lab' => $keep_lab} );
+}
+
+$LAB->open_lab;
-#XXX: There has to be a cleaner way to do this
-# Update the ENV var as well
-$ENV{'LINTIAN_LAB'} = $opt{'LINTIAN_LAB'} = $LAB->{dir};
+# Update the ENV var as well - unlike the original values,
+# $LAB->dir is always absolute
+$ENV{'LINTIAN_LAB'} = $opt{'LINTIAN_LAB'} = $LAB->dir;
# }}}
@@@ -940,7 -936,6 +940,7 @@@ while (my $arg = shift)
# special case: search only in lab if action is `remove'
my $search;
+ my @res;
if ($action eq 'remove') {
# search only in lab--see below
$search = 'lab';
@@@ -951,23 -946,24 +951,23 @@@
my $found = 0;
if (($pkg_mode eq 'b') or ($pkg_mode eq 'a')) {
- $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'});
+ $bin_info = load_pkg_list('binary', "$opt{'LINTIAN_LAB'}/info/binary-packages") unless $bin_info;
+ if ($bin_info->get($arg)) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->get($arg)->{'file'});
$found = 1;
}
}
if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
- $udeb_info = read_bin_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
- if ($udeb_info->{$arg}) {
- $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->{$arg}->{'file'});
+ $udeb_info = load_pkg_list('udeb', "$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
+ if ($udeb_info->get($arg)) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->get($arg)->{'file'});
$found = 1;
}
}
if (($pkg_mode eq 's') or ($pkg_mode eq 'a')) {
- $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'});
+ $src_info = load_pkg_list('source', "$opt{'LINTIAN_LAB'}/info/source-packages") unless $src_info;
+ if ($src_info->get($arg)) {
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->get($arg)->{'file'});
$found = 1;
}
}
@@@ -977,60 -973,74 +977,60 @@@
# nothing found so far, so search the lab
- my $b = "$opt{'LINTIAN_LAB'}/binary/$arg";
- my $s = "$opt{'LINTIAN_LAB'}/source/$arg";
- my $u = "$opt{'LINTIAN_LAB'}/udeb/$arg";
+ if ($pkg_mode eq 'b' or $pkg_mode eq 'a') {
+ my @pkgs = $LAB->get_package ($arg, 'binary');
+ push @res, @pkgs;
+ }
+ if ($pkg_mode eq 's' or $pkg_mode eq 'a') {
+ my @pkgs = $LAB->get_package ($arg, 'source');
+ push @res, @pkgs;
+ }
+ if ($pkg_mode eq 'u' or $pkg_mode eq 'a') {
+ my @pkgs = $LAB->get_package ($arg, 'udeb');
+ push @res, @pkgs;
+ }
+ if ($pkg_mode eq 'c' or $pkg_mode eq 'a') {
+ my @pkgs = $LAB->get_package ($arg, 'changes');
+ push @res, @pkgs;
+ }
- if ($pkg_mode eq 'b') {
- unless (-d $b) {
- warn "error: cannot find binary package $arg in $search (skipping)\n";
- $exit_code = 2;
- next;
- }
- } elsif ($pkg_mode eq 's') {
- unless (-d $s) {
- warning("cannot find source package $arg in $search (skipping)");
- $exit_code = 2;
- next;
- }
- } elsif ($pkg_mode eq 'u') {
- unless (-d $u) {
- warning("cannot find udeb package $arg in $search (skipping)");
- $exit_code = 2;
- next;
+ if (@res) {
+ foreach my $p (@res) {
+ $pool->add_proc ($p);
}
} else {
- # $pkg_mode eq 'a'
- unless (-d $b or -d $s or -d $u) {
- warning("cannot find binary, udeb or source package $arg in $search (skipping)");
- $exit_code = 2;
- next;
- }
+ warning("cannot find binary, udeb or source package $arg in $search (skipping)");
+ $exit_code = 2;
+ next;
}
- # FIXME: Use Lab to find the deb/dsc instead?
- if (($pkg_mode eq 'b') or (($pkg_mode eq 'a') and (-d $b))) {
- $pool->add_file("$b/deb");
- }
- if (($pkg_mode eq 's') or (($pkg_mode eq 'a') and (-d $s))) {
- $pool->add_file("$s/dsc");
- }
- if (($pkg_mode eq 'u') or (($pkg_mode eq 'a') and (-d $u))) {
- $pool->add_file("$u/deb");
- }
}
}
if ($check_everything) {
# make sure package info is available
- $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_bin_list("$opt{'LINTIAN_LAB'}/info/udeb-packages") unless $udeb_info;
+ $src_info = load_pkg_list('source', "$opt{'LINTIAN_LAB'}/info/source-packages") unless $src_info;
+ $bin_info = load_pkg_list('binary', "$opt{'LINTIAN_LAB'}/info/binary-packages") unless $bin_info;
+ $udeb_info = load_pkg_list('udeb', "$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 %$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'});
+ for my $arg (sort $src_info->get_all) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->get($arg)->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $src_info->get($arg)->{'file'});
}
}
if (($pkg_mode eq 'a') or ($pkg_mode eq 'b')) {
- 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'});
+ for my $arg (sort $bin_info->get_all) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->get($arg)->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $bin_info->get($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 $udeb_info->get_all) {
+ debug_msg(1, "doing stuff with $opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->get($arg)->{'file'});
+ $pool->add_file("$opt{'LINTIAN_ARCHIVEDIR'}/" . $udeb_info->get($arg)->{'file'});
}
}
} elsif ($packages_file) {
@@@ -1094,11 -1104,12 +1094,11 @@@ if($action eq 'remove')
my $pkg_path = $proc->pkg_path();
my $pkg_arch = $proc->pkg_arch();
eval{
- $lpkg = $LAB->get_lab_package($pkg_name, $pkg_ver, $pkg_arch,
- $pkg_type, $pkg_path);
+ $lpkg = $LAB->get_package($proc);
};
- if(!defined($lpkg)){
+ if (!defined $lpkg){
my $err = '.';
- $err = ": $@" if(defined($@));
+ $err = ": $@" if defined $@;
warning("skipping $action of $pkg_type package ${pkg_name}$err");
$exit_code = 2;
next;
@@@ -1113,8 -1124,6 +1113,8 @@@
}
}
$TAGS->file_end();
+ # Write the lab state to the disk, so it remembers they are gone.
+ $LAB->close_lab();
exit $exit_code;
}
# }}}
@@@ -1207,16 -1216,23 +1207,23 @@@ if ($action eq 'unpack')
push @needed, @{$collection_info{$c}{'needs-info'}};
}
}
- if ($unpack_info) {
- # Add collections specifically requested by the user (--unpack-info)
- for my $i (split(/,/,$unpack_info)) {
- unless ($collection_info{$i}) {
- fail("unknown info specified: $i");
- }
- $unpack_infos{$i} = 1;
+ }
+
+ if ($unpack_info) {
+ # Add collections specifically requested by the user (--unpack-info)
+ for my $i (split(/,/,$unpack_info)) {
+ unless ($collection_info{$i}) {
+ fail("unknown info specified: $i");
}
+ $unpack_infos{$i} = 1;
+ # This implies always keeping them as well! Note that auto_clean_package
+ # depends on this to do the "right thing". If you remove this, please
+ # remember to update auto_clean_package.
+ $collection_info{$i}{'auto-remove'} = 0;
}
}
+
+
# }}}
# {{{ Create the dependency tree and populate it with checks and collections
@@@ -1274,8 -1290,6 +1281,8 @@@ foreach my $gname (sort $pool->get_grou
}
}
+# Write the lab state to the disk, so it remembers the new packages
+$LAB->close_lab();
$TAGS->file_end();
if ($action eq 'check' and not $opt{'no-override'} and not $opt{'show-overrides'}) {
@@@ -1475,6 -1489,10 +1482,10 @@@ sub load_checks
# Removes all collections with "Auto-Remove: yes"; takes a Lab::Package
# - depends on global variables %collection_info and $opt{'LINTIAN_ROOT'}
+ #
+ # Note: collections explicitly requested by the user (using -U coll) will
+ # not be auto-removed *because* the argument handling of -U alters the
+ # Auto-Remove value for these collections.
sub auto_clean_package {
my ($lpkg) = @_;
my $pkg_name = $lpkg->pkg_name();
@@@ -1483,7 -1501,7 +1494,7 @@@
for my $coll (keys %collection_info) {
my $ci = $collection_info{$coll};
if (defined($ci->{'auto-remove'}) && $ci->{'auto-remove'} eq 'yes') {
- next unless (-f "$base/.${coll}-$ci->{'version'}");
+ 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) {
@@@ -1491,7 -1509,8 +1502,7 @@@
"skipping cleanup of $pkg_type package $pkg_name");
return 0;
}
- unlink("$base/.${coll}-$ci->{'version'}")
- or fail("failed to remove status file of collect info $coll about package $pkg_name");
+ $lpkg->_clear_coll_status ($coll);
}
}
return 1;
@@@ -1544,11 -1563,12 +1555,11 @@@ sub unpack_group
my $base;
my $info;
eval{
- $lpkg = $LAB->get_lab_package($pkg_name, $pkg_ver, $pkg_arch,
- $pkg_type, $pkg_path);
+ $lpkg = $LAB->get_package($proc);
};
- if(!defined($lpkg)){
+ if (!defined $lpkg) {
my $err = '.';
- $err = ": $@" if(defined($@));
+ $err = ": $@" if defined $@;
warning("skipping $action of $pkg_type package ${pkg_name}$err");
$exit_code = 2;
$group->remove_processable($proc);
@@@ -1583,7 -1603,7 +1594,7 @@@
}
# check if it has been run previously
- if ($lpkg->_is_coll_finished($coll, $ci->{'version'})) {
+ if ($lpkg->is_coll_finished($coll, $ci->{'version'})) {
$collmap->satisfy($req);
next;
}
@@@ -1592,6 -1612,9 +1603,6 @@@
# collect info
$collmap->select($req);
- unless ($lpkg->remove_status_file()) {
- warning("cannot remove status file $pkg_name: $!");
- }
debug_msg(1, "Collecting info: $coll ...");
my $script = "$opt{'LINTIAN_ROOT'}/collection/$ci->{'script'}";
my $cmd = Lintian::Command::Simple->new();
@@@ -1632,8 -1655,7 +1643,7 @@@
# We only need this if we are checking the package later
$proc->lab_pkg($lpkg);
} else {
- # else we are done - not sure if it makes any sense if we are unpacking
- # but this is the old behaviour, so we stick with it.
+ # else we are done
if (!$keep_lab) {
auto_clean_package($lpkg) or $exit_code = 2;
}
@@@ -1761,21 -1783,12 +1771,21 @@@ sub clear_group_cache
return 1;
}
+# Loads a package list using Lintian::Internal::PackageList and returns
+# the newly created object.
+sub load_pkg_list {
+ my ($pkg_type, $file) = @_;
+ my $plist = Lintian::Internal::PackageList->new($pkg_type);
+ $plist->read_list($file);
+ return $plist;
+}
+
# }}}
# {{{ Exit handler.
sub END {
- # Prevent Lab::delete from affecting the exit code.
+ # Prevent Lab->close_lab from affecting the exit code.
local $?;
$SIG{'INT'} = 'DEFAULT';
@@@ -1787,7 -1800,7 +1797,7 @@@
%running_jobs = ();
}
- $LAB->delete() if $LAB and not $keep_lab;
+ $LAB->close_lab if $LAB;
}
sub interrupted {
diff --combined reporting/html_reports
index 19a4eb4,438d09a..29ec7d8
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@@ -33,16 -33,12 +33,12 @@@ use Text::Template ()
# These have no default and must be set in the configuration file.
# FIXME: $statistics_file should be in all caps as well.
our ($LINTIAN_ROOT, $LINTIAN_LAB, $LINTIAN_ARCHIVEDIR, $LINTIAN_DIST,
- $LINTIAN_SECTION, $LINTIAN_ARCH, $HTML_TMP_DIR, $statistics_file,
+ $LINTIAN_ARCH, $HTML_TMP_DIR, $statistics_file,
$LINTIAN_AREA, $HISTORY, $HISTORY_DIR, $LINTIAN_SOURCE);
# Read the configuration.
require './config';
- if (defined $LINTIAN_SECTION and not defined $LINTIAN_AREA) {
- $LINTIAN_AREA = $LINTIAN_SECTION;
- }
-
# The path to the mirror timestamp.
our $LINTIAN_TIMESTAMP
= "$LINTIAN_ARCHIVEDIR/project/trace/ftp-master.debian.org";
@@@ -55,7 -51,7 +51,7 @@@ $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT
# Import Lintian Perl libraries.
use lib "$ENV{LINTIAN_ROOT}/lib";
use Lintian::Tag::Info ();
-use Read_pkglists;
+use Lintian::Lab::Manifest;
use Text_utils;
use Util;
@@@ -110,22 -106,17 +106,22 @@@ for my $template (qw/head foot clean in
# Read the package lists.
#
-my %binary_info = %{ read_bin_list("$LINTIAN_LAB/info/binary-packages"); };
-my %udeb_info = %{ read_bin_list("$LINTIAN_LAB/info/udeb-packages"); };
-my %source_info = %{ read_src_list("$LINTIAN_LAB/info/source-packages"); };
+my $binary_info = Lintian::Lab::Manifest->new ('binary');
+my $udeb_info = Lintian::Lab::Manifest->new ('udeb');
+my $source_info = Lintian::Lab::Manifest->new ('source');
my %bin_src_ref;
-for my $source (keys %source_info) {
- for my $binary (split(/,\s+/o,$source_info{$source}->{'binary'})) {
+$binary_info->read_list("$LINTIAN_LAB/info/binary-packages");
+$udeb_info->read_list("$LINTIAN_LAB/info/udeb-packages");
+$source_info->read_list("$LINTIAN_LAB/info/source-packages");
+
+$source_info->visit_all (sub {
+ my ($entry) = @_;
+ my $source = $entry->{'source'};
+ foreach my $binary (split m/\s*,\s*+/o, $entry->{'binary'}) {
$bin_src_ref{$binary} = $source;
}
-}
-
+});
# Create output directories.
mkdir($HTML_TMP_DIR, 0777)
@@@ -242,40 -233,34 +238,40 @@@ while (<>)
# there is any.
my ($source, $version, $area, $source_version, $maintainer, $uploaders);
if ($type eq 'source') {
+ my $srcdata;
+ $source_info->visit_all (sub { $srcdata = $_[0] });
$source = $package;
- if (exists $source_info{$source}) {
- $version = $source_info{$source}->{version};
- $area = $source_info{$source}->{area};
- $maintainer = $source_info{$source}->{maintainer};
- $uploaders = $source_info{$source}->{uploaders};
+ if (defined $srcdata) {
+ $version = $srcdata->{version};
+ $area = $srcdata->{area};
+ $maintainer = $srcdata->{maintainer};
+ $uploaders = $srcdata->{uploaders};
} else {
warn "source package $package not listed!\n";
}
} else {
+ my $srcdata;
+ my $bindata;
$source = $bin_src_ref{$package};
- if ($source and exists $source_info{$source}) {
- $maintainer = $source_info{$source}->{maintainer};
- $uploaders = $source_info{$source}->{uploaders};
+ $source_info->visit_all (sub { $srcdata = $_[0] }) if $source;
+ if (defined $srcdata) {
+ $maintainer = $srcdata->{maintainer};
+ $uploaders = $srcdata->{uploaders};
} else {
warn "source for package $package not found!\n";
$source = $package;
$maintainer = undef;
}
if ($type eq 'binary') {
- $version = $binary_info{$package}->{version};
- $area = $binary_info{$source}->{area};
- $source_version = $binary_info{$package}->{'source-version'};
+ $binary_info->visit_all (sub { $bindata = $_[0] });
} elsif ($type eq 'udeb') {
- $version = $udeb_info{$package}->{version};
- $area = $udeb_info{$source}->{area};
- $source_version = $udeb_info{$package}->{'source-version'};
+ $udeb_info->visit_all (sub { $bindata = $_[0] });
+ } else {
+ fail "Unknown type or unhandled case ($type).\n";
}
+ $version = $bindata->{version};
+ $area = $bindata->{area};
+ $source_version = $bindata->{'source-version'};
}
$maintainer ||= '(unknown)';
$area ||= 'main';
@@@ -334,12 -319,11 +330,12 @@@
# this later to generate stub pages for maintainers whose packages are all
# Lintian-clean.
my %clean;
-for my $source (keys %source_info) {
- my $maintainer = $source_info{$source}->{maintainer};
+$source_info->visit_all (sub {
+ my ($srcdata) = @_;
+ my $maintainer = $srcdata->{maintainer};
my $id = maintainer_url ($maintainer);
$clean{$id} = $maintainer;
-}
+});
# Now, walk through the tags by source package (sorted by maintainer). Output
# a summary page of errors and warnings for each maintainer, output a full
--
Debian package checker
Reply to: