[SCM] Debian package checker branch, master, updated. 1.24.4-97-g32df205
The following commit has been merged in the master branch:
commit f671c8003981bb140996a6c96e1f9e6fc84080a3
Author: Frank Lichtenheld <djpig@debian.org>
Date: Wed Sep 3 03:59:43 2008 +0200
Improve scheduling code
* frontend/lintian:
+ Use new module Lintian::Schedule and make package architecture
available to output formatters if possible.
Currently used only by experimental colon-separated output.
* lib/Lintian/Schedule.pm:
+ Factor out some scheduling code.
diff --git a/debian/changelog b/debian/changelog
index 9a39ddd..44ea465 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -67,6 +67,9 @@ lintian (2.0.0~rc1) experimental; urgency=low
shell prompt. (Closes: #496295)
+ [FL] Actually make package version available to output formatters.
Currently used only by experimental colon-separated output.
+ + [FL] Use new module Lintian::Schedule and make package architecture
+ available to output formatters if possible.
+ Currently used only by experimental colon-separated output.
* lib/Tags/ColonSeparated.pm:
+ [FL] Update for new features and make a little bit easier to read
@@ -76,6 +79,8 @@ lintian (2.0.0~rc1) experimental; urgency=low
- Move the detailled override info to the end but include info
flag about the override status in the same column that also
includes the experimental flag info.
+ * lib/Lintian/Schedule.pm:
+ + [FL] Factor out some scheduling code.
* t/runtests:
+ [FL] Copy the changes to testset/runtests from JP's branch.
diff --git a/frontend/lintian b/frontend/lintian
index 0aa15cb..3e3d9e3 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -75,7 +75,7 @@ my @certainties = qw(wild-guess possible certain);
my %display_level = ();
my %display_source = ();
-my @packages;
+my $schedule;
my $action;
my $checks;
@@ -591,6 +591,8 @@ import Pipeline;
require Tags;
import Tags;
+require Lintian::Schedule;
+
my @l_secs = read_dpkg_control("$LINTIAN_ROOT/checks/lintian.desc");
shift(@l_secs);
map { $_->{'script'} = 'lintian'; Tags::add_tag($_) } @l_secs;
@@ -704,6 +706,7 @@ END {
# {{{ Compile list of files to process
+$schedule = new Lintian::Schedule(verbose => $verbose);
# process package/file arguments
while (my $arg = shift) {
# file?
@@ -715,30 +718,18 @@ while (my $arg = shift) {
# .deb file?
if ($arg =~ /\.deb$/) {
- my $info = get_deb_info($arg);
- if (not defined $info) {
- print STDERR "$arg is a zero-byte file, skipping\n";
- next;
- }
- schedule_package('b', $info->{'package'}, $info->{'version'}, $arg);
+ $schedule->add_deb('b', $arg)
+ or warn "$arg is a zero-byte file, skipping\n";
}
# .udeb file?
elsif ($arg =~ /\.udeb$/) {
- my $info = get_deb_info($arg);
- if (not defined $info) {
- print STDERR "$arg is a zero-byte file, skipping\n";
- next;
- }
- schedule_package('u', $info->{'package'}, $info->{'version'}, $arg);
+ $schedule->add_deb('u', $arg)
+ or warn "$arg is a zero-byte file, skipping\n";
}
# .dsc file?
elsif ($arg =~ /\.dsc$/) {
- my $info = get_dsc_info($arg);
- if (not defined $info) {
- print STDERR "$arg is a zero-byte file, skipping\n";
- next;
- }
- schedule_package('s', $info->{'source'}, $info->{'version'}, $arg);
+ $schedule->add_dsc($arg)
+ or warn "$arg is a zero-byte file, skipping\n";
}
# .changes file?
elsif ($arg =~ /\.changes$/) {
@@ -862,17 +853,11 @@ while (my $arg = shift) {
# process file?
if ($file =~ /\.dsc$/) {
- my $info = get_dsc_info($filename);
- schedule_package('s', $info->{'source'},
- $info->{'version'}, $filename);
+ $schedule->add_dsc($filename);
} elsif ($file =~ /\.deb$/) {
- my $info = get_deb_info($filename);
- schedule_package('b', $info->{'package'},
- $info->{'version'}, $filename);
+ $schedule->add_deb('b', $filename);
} elsif ($file =~ /\.udeb$/) {
- my $info = get_deb_info($filename);
- schedule_package('u', $info->{'package'},
- $info->{'version'}, $filename);
+ $schedule->add_deb('u', $filename);
}
}
@@ -910,25 +895,22 @@ while (my $arg = shift) {
if (($pkg_mode eq 'b') or ($pkg_mode eq 'a')) {
if ($binary_info{$arg}) {
- schedule_package('b', $binary_info{$arg}->{'package'},
- $binary_info{$arg}->{'version'},
- "$LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}");
+ $schedule->add_file('b', "$LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}",
+ %{$binary_info{$arg}});
$found = 1;
}
}
if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
if ($udeb_info{$arg}) {
- schedule_package('u', $udeb_info{$arg}->{'package'},
- $udeb_info{$arg}->{'version'},
- "$LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}");
+ $schedule->add_file('u', "$LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}",
+ %{$udeb_info{$arg}});
$found = 1;
}
}
if (($pkg_mode eq 's') or ($pkg_mode eq 'a')) {
if ($source_info{$arg}) {
- schedule_package('s', $source_info{$arg}->{'source'},
- $source_info{$arg}->{'version'},
- "$LINTIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}");
+ $schedule->add_file('s', "$LINTIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}",
+ %{$source_info{$arg}});
$found = 1;
}
}
@@ -970,18 +952,18 @@ while (my $arg = shift) {
}
if (($pkg_mode eq 'b') or (($pkg_mode eq 'a') and (-d $b))) {
- schedule_package('b', get_bin_info_from_lab($b));
+ $schedule->add_file('b', get_bin_info_from_lab($b));
}
if (($pkg_mode eq 's') or (($pkg_mode eq 'a') and (-d $s))) {
- schedule_package('s', get_src_info_from_lab($s));
+ $schedule->add_file('s', get_src_info_from_lab($s));
}
if (($pkg_mode eq 'u') or (($pkg_mode eq 'a') and (-d $u))) {
- schedule_package('u', get_bin_info_from_lab($u));
+ $schedule->add_file('u', get_bin_info_from_lab($u));
}
}
}
-if (not $check_everything and not $packages_file and ($#packages == -1)) {
+if (not $check_everything and not $packages_file and not $schedule->count) {
print "N: No packages selected.\n" if $verbose;
exit $exit_code;
}
@@ -1244,39 +1226,36 @@ if ($check_everything) {
if (($pkg_mode eq 'a') or ($pkg_mode eq 's')) {
for my $arg (keys %source_info) {
print STDERR "doing stuff with $LINTIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}\n" if $debug;
- push(@packages,"s $source_info{$arg}->{'source'} $source_info{$arg}->{'version'} $LINTIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}");
+ $schedule->add_file('s', "$LINTIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}",
+ %{$source_info{$arg}});
}
}
if (($pkg_mode eq 'a') or ($pkg_mode eq 'b')) {
for my $arg (keys %binary_info) {
print STDERR "doing stuff with $LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}\n" if $debug;
- push(@packages,"b $binary_info{$arg}->{'package'} $binary_info{$arg}->{'version'} $LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}");
+ $schedule->add_file('b', "$LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}",
+ %{$binary_info{$arg}});
}
}
if (($pkg_mode eq 'a') or ($pkg_mode eq 'u')) {
for my $arg (keys %udeb_info) {
print STDERR "doing stuff with $LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}\n" if $debug;
- push(@packages,"u $udeb_info{$arg}->{'package'} $udeb_info{$arg}->{'version'} $LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}");
+ $schedule->add_file('u', "$LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}",
+ %{$udeb_info{$arg}});
}
}
# package list still empty?
- if ($#packages == -1) {
+ unless ($schedule->count) {
print STDERR "warning: no packages found in distribution directory\n";
}
} elsif ($packages_file) { # process all packages listed in packages file?
- open(IN, '<', $packages_file)
- or fail("cannot open packages file $packages_file for reading: $!");
- while (<IN>) {
- chop;
- push(@packages,$_);
- }
- close(IN);
+ $schedule->add_pkg_list($packages_file);
}
# }}}
# {{{ Some silent exit
-if ($#packages == -1) {
+unless ($schedule->count) {
print "N: No packages selected.\n" if $verbose;
exit 0;
}
@@ -1284,7 +1263,7 @@ if ($#packages == -1) {
# {{{ Okay, now really processing the packages in one huge loop
$unpack_infos{ "override-file" } = 1 unless $no_override;
-printf "N: Processing %d packages...\n",$#packages+1 if $verbose;
+printf "N: Processing %d packages...\n", $schedule->count if $verbose;
if ($debug) {
print "N: Selected action: $action\n";
print "N: Requested unpack level: $unpack_level\n";
@@ -1295,21 +1274,19 @@ if ($debug) {
require Checker;
require Lintian::Collect;
-# for each package (the `reverse sort' is to make sure that source packages are
-# before the corresponding binary packages--this has the advantage that binary
-# can use information from the source packages if these are unpacked)
my %overrides;
PACKAGE:
-for (reverse sort @packages) {
- m/^([bsu]) (\S+) (\S+) (.+)$/ or fail("syntax error in \@packages array: $_");
- my ($type,$pkg,$ver,$file) = ($1,$2,$3,$4);
- my $long_type = ($type eq 'b' ? 'binary' : ($type eq 's' ? 'source' : 'udeb' ));
+foreach my $pkg_info ($schedule->get_all) {
+ my ($type, $pkg, $ver, $arch, $file) =
+ @$pkg_info{qw(type package version architecture file)};
+ my $long_type = ($type eq 'b' ? 'binary' :
+ ($type eq 's' ? 'source' : 'udeb' ));
if ($verbose) {
print "N: ----\n";
print "N: Processing $long_type package $pkg (version $ver) ...\n";
}
- Tags::set_pkg( $file, $pkg, $ver, "", $long_type );
+ Tags::set_pkg( $file, $pkg, $ver, $arch, $long_type );
# determine base directory
my $base = "$LINTIAN_LAB/$long_type/$pkg";
@@ -1722,7 +1699,7 @@ sub remove_status_file {
# get package name, version, and file name from the lab
sub get_bin_info_from_lab {
my ($base_dir) = @_;
- my ($pkg,$ver,$file);
+ my ($pkg,$ver,$arch,$file);
($pkg = read_file("$base_dir/fields/package"))
or fail("cannot read file $base_dir/fields/package: $!");
@@ -1730,10 +1707,13 @@ sub get_bin_info_from_lab {
($ver = read_file("$base_dir/fields/version"))
or fail("cannot read file $base_dir/fields/version: $!");
+ ($arch = read_file("$base_dir/fields/architecture"))
+ or fail("cannot read file $base_dir/fields/architecture: $!");
+
($file = readlink("$base_dir/deb"))
or fail("cannot read link $base_dir/deb: $!");
- return ($pkg,$ver,$file);
+ return ($file, package => $pkg, version => $ver, architecture => $arch);
}
# get package name, version, and file name from the lab
@@ -1750,24 +1730,7 @@ sub get_src_info_from_lab {
($file = readlink("$base_dir/dsc"))
or fail("cannot read link $base_dir/dsc: $!");
- return ($pkg,$ver,$file);
-}
-
-# schedule a package for processing
-sub schedule_package {
- my ($type,$pkg,$ver,$file) = @_;
-
- my $s = "$type $pkg $ver $file";
-
- if ( $already_scheduled{$s}++ ) {
- if ($verbose) {
- printf "N: Ignoring duplicate %s package $pkg (version $ver)\n",
- $type eq 'b' ? 'binary' : ($type eq 's' ? 'source': 'udeb');
- }
- return;
- }
-
- push(@packages,$s);
+ return ($file, source => $pkg, version => $ver);
}
# -------------------------------
diff --git a/lib/Lintian/Schedule.pm b/lib/Lintian/Schedule.pm
new file mode 100644
index 0000000..3c36363
--- /dev/null
+++ b/lib/Lintian/Schedule.pm
@@ -0,0 +1,110 @@
+# Copyright (C) 2008 Frank Lichtenheld <frank@lichtenheld.de>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# 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 Lintian::Schedule;
+
+use strict;
+use warnings;
+
+use Util;
+
+sub new {
+ my ($class, %options) = @_;
+ my $self = {};
+
+ bless($self, $class);
+
+ $self->{opts} = \%options;
+ $self->{schedule} = [];
+ $self->{unique} = {};
+
+ return $self;
+}
+
+# schedule a package for processing
+sub add_file {
+ my ($self, $type, $file, %pkg_info) = @_;
+
+ my ($pkg, $ver, $arch) = ("", "", "");
+ if ($type eq 's') {
+ ($pkg, $ver, $arch) =
+ (@pkg_info{qw(source version)}, 'source');
+ } else {
+ ($pkg, $ver, $arch) =
+ @pkg_info{qw(package version architecture)};
+ }
+
+ my $s = "$type $pkg $ver $arch $file";
+ my %h = ( type => $type, package => $pkg, version => $ver,
+ architecture => $arch, file => $file );
+
+ if ( $self->{unique}{$s}++ ) {
+ if ($self->{opts}{verbose}) {
+ printf "N: Ignoring duplicate %s package $pkg (version $ver)\n",
+ $type eq 'b' ? 'binary' : ($type eq 's' ? 'source': 'udeb');
+ }
+ return;
+ }
+
+ push(@{$self->{schedule}}, \%h);
+ return 1;
+}
+
+sub add_deb {
+ my ($self, $type, $file) = @_;
+
+ my $info = get_deb_info($file);
+ return unless defined $info;
+ return $self->add_file($type, $file, %$info);
+}
+
+sub add_dsc {
+ my ($self, $file) = @_;
+
+ my $info = get_dsc_info($file);
+ return unless defined $info;
+ return $self->add_file('s', $file, %$info);
+}
+
+sub add_pkg_list {
+ my ($self, $packages_file) = @_;
+
+ open(IN, '<', $packages_file)
+ or die("cannot open packages file $packages_file for reading: $!");
+ while (<IN>) {
+ chomp;
+ my ($type, $pkg, $ver, $file) = split(/\s+/, $_, 4);
+ $self->add_file($type, $file, package => $pkg, version => $ver);
+ }
+ close(IN);
+}
+
+# for each package (the sort is to make sure that source packages are
+# before the corresponding binary packages--this has the advantage that binary
+# can use information from the source packages if these are unpacked)
+my %type_sort = ('b' => 1, 'u' => 1, 's' => 2 );
+sub get_all {
+ return sort({$type_sort{$b->{type}} <=> $type_sort{$a->{type}}}
+ @{$_[0]->{schedule}});
+}
+
+sub count {
+ return scalar @{$_[0]->{schedule}};
+}
+
+1;
--
Debian package checker
Reply to: