The following commit has been merged in the master branch:
commit 8c3909051e5673a42d14f2c5ca901f8947dc4fd5
Author: Russ Allbery <[email protected]>
Date: Mon Dec 21 23:23:18 2009 -0800
Switch from Tags to Lintian::Tags and fix uncovered bugs
* checks/*:
+ [RA] Use Lintian::Tags instead of Tags.
* frontend/lintian:
+ [RA] Create a global Lintian::Tags object and use it instead of
setting variables in the Tags namespace. Move display level code
from here to Lintian::Tags. Adjust calls for the new Lintian::Tags
module.
* lib/Lintian/Check.pm:
+ [RA] Use Lintian::Tags instead of Tags.
* lib/Lintian/Output.pm:
+ [RA] print_tag() now takes an additional argument containing
override data and expects a Lintian::Tag::Info object as the tag
info instead of a hash.
+ [RA] Adjust for the renaming of pkg in the file information hash.
* lib/Lintian/Output/*.pm:
+ [RA] Adjust for print_tag() and file information hash changes.
* lib/Lintian/Tags.pm:
+ [RA] New module in a proper namespace replacing Tags.pm. A global
Lintian::Tags object replaces the static variables in the Tags
namespace, with new accessor functions, except for the tag metadata
functions (which have moved to Lintian::Tag::Info). All handling of
display levels is now here instead of in frontend/lintian.
* lib/Spelling.pm:
+ [RA] Use Lintian::Tags instead of Tags.
diff --git a/checks/binaries b/checks/binaries
index b9aa525..fb2fcda 100644
--- a/checks/binaries
+++ b/checks/binaries
@@ -20,9 +20,9 @@
package Lintian::binaries;
use strict;
-use Tags;
use Util;
use Spelling;
+use Lintian::Tags qw(tag);
use File::Spec;
diff --git a/checks/changelog-file b/checks/changelog-file
index 4d5eb82..cf2ac4d 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -22,8 +22,8 @@ package Lintian::changelog_file;
use strict;
use Lintian::Relation::Version qw(versions_gt);
+use Lintian::Tags qw(tag);
use Spelling;
-use Tags;
use Util;
use Encode qw(decode);
diff --git a/checks/conffiles b/checks/conffiles
index 456c041..7e43522 100644
--- a/checks/conffiles
+++ b/checks/conffiles
@@ -20,8 +20,8 @@
package Lintian::conffiles;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/control-file b/checks/control-file
index 180be7c..9ac6668 100644
--- a/checks/control-file
+++ b/checks/control-file
@@ -25,7 +25,7 @@ use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
use Lintian::Relation ();
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
# The list of libc packages, used for checking for a hard-coded dependency
diff --git a/checks/control-files b/checks/control-files
index 85d433d..33e0ad6 100644
--- a/checks/control-files
+++ b/checks/control-files
@@ -20,8 +20,8 @@
package Lintian::control_files;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
my %ctrl_deb =
(clilibs => 0644,
diff --git a/checks/copyright-file b/checks/copyright-file
index e4d2b1d..a45a5dc 100644
--- a/checks/copyright-file
+++ b/checks/copyright-file
@@ -25,8 +25,8 @@ use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
use Lintian::Data ();
+use Lintian::Tags qw(tag);
use Spelling;
-use Tags;
use Util;
use Encode qw(decode);
diff --git a/checks/cruft b/checks/cruft
index 47d2bf8..4e833f6 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -26,7 +26,7 @@ package Lintian::cruft;
use strict;
use Lintian::Relation ();
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
use Cwd;
diff --git a/checks/deb-format b/checks/deb-format
index 84a840b..526e2f6 100644
--- a/checks/deb-format
+++ b/checks/deb-format
@@ -17,9 +17,9 @@
package Lintian::deb_format;
use strict;
-use Tags;
use Lintian::Command qw(spawn);
+use Lintian::Tags qw(tag);
# The files that contain error messages from tar, which we'll check and issue
# tags for if they contain something unexpected, and their corresponding tags.
diff --git a/checks/debconf b/checks/debconf
index c5c47fa..ead94f5 100644
--- a/checks/debconf
+++ b/checks/debconf
@@ -20,9 +20,9 @@
package Lintian::debconf;
use strict;
-use Tags;
use Lintian::Relation;
+use Lintian::Tags qw(tag);
use Util;
# From debconf-devel(7), section 'THE TEMPLATES FILE', up to date with debconf
diff --git a/checks/debhelper b/checks/debhelper
index 00f917a..60d8334 100644
--- a/checks/debhelper
+++ b/checks/debhelper
@@ -22,9 +22,9 @@ package Lintian::debhelper;
use strict;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Tags;
use Util;
use Lintian::Data;
+use Lintian::Tags qw(tag);
# If there is no debian/compat file present but cdbs is being used, cdbs will
# create one automatically. Currently it always uses compatibility level 5.
diff --git a/checks/debian-readme b/checks/debian-readme
index 6dfbedb..729cc8f 100644
--- a/checks/debian-readme
+++ b/checks/debian-readme
@@ -21,7 +21,7 @@
package Lintian::debian_readme;
use strict;
use Spelling;
-use Tags;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/description b/checks/description
index 021fd66..90c7d2b 100644
--- a/checks/description
+++ b/checks/description
@@ -23,8 +23,8 @@ use strict;
use Encode qw(decode);
+use Lintian::Tags qw(tag);
use Spelling;
-use Tags;
use Util;
sub run {
diff --git a/checks/etcfiles b/checks/etcfiles
index abff91b..bc61715 100644
--- a/checks/etcfiles
+++ b/checks/etcfiles
@@ -20,8 +20,8 @@
package Lintian::etcfiles;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/fields b/checks/fields
index fc118a5..e7e4fcf 100644
--- a/checks/fields
+++ b/checks/fields
@@ -27,13 +27,14 @@ use strict;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
-use Tags;
+
use Util;
use Lintian::Data ();
use Lintian::Check qw(check_maintainer);
use Lintian::Relation ();
use Lintian::Relation::Version qw(versions_compare);
+use Lintian::Tags qw(tag);
our $KNOWN_ARCHS = Lintian::Data->new('fields/architectures');
our $KNOWN_ESSENTIAL = Lintian::Data->new('fields/essential');
diff --git a/checks/files b/checks/files
index 46f8221..8f77421 100644
--- a/checks/files
+++ b/checks/files
@@ -20,9 +20,9 @@
package Lintian::files;
use strict;
-use Tags;
use Util;
use Lintian::Data;
+use Lintian::Tags qw(tag);
our $FONT_PACKAGES;
diff --git a/checks/huge-usr-share b/checks/huge-usr-share
index 7d47d21..ab6745f 100644
--- a/checks/huge-usr-share
+++ b/checks/huge-usr-share
@@ -20,7 +20,7 @@
package Lintian::huge_usr_share;
use strict;
-use Tags;
+use Lintian::Tags qw(tag);
# Threshold in kB of /usr/share to trigger this warning. Consider that the
# changelog alone can be quite big, and cannot be moved away.
diff --git a/checks/infofiles b/checks/infofiles
index 8c0dc5c..6e5d9f3 100644
--- a/checks/infofiles
+++ b/checks/infofiles
@@ -25,8 +25,9 @@ use strict;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
+
use File::Basename qw(fileparse);
sub run {
diff --git a/checks/init.d b/checks/init.d
index 1b1d649..b0ba8b2 100644
--- a/checks/init.d
+++ b/checks/init.d
@@ -20,8 +20,8 @@
package Lintian::init_d;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
# A list of valid LSB keywords. The value is 0 if optional and 1 if
required.
my %lsb_keywords = (provides => 1,
diff --git a/checks/manpages b/checks/manpages
index 261920f..d633abf 100644
--- a/checks/manpages
+++ b/checks/manpages
@@ -20,8 +20,8 @@
package Lintian::manpages;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/menu-format b/checks/menu-format
index 9568ad1..b8b26cb 100644
--- a/checks/menu-format
+++ b/checks/menu-format
@@ -34,8 +34,10 @@
package Lintian::menu_format;
use strict;
-use Tags;
+
+use Lintian::Tags qw(tag);
use Util;
+
use File::Basename;
# This is a list of all tags that should be in every menu item.
diff --git a/checks/menus b/checks/menus
index bbc185b..7fc81f9 100644
--- a/checks/menus
+++ b/checks/menus
@@ -27,8 +27,8 @@ use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
use Lintian::Data;
+use Lintian::Tags qw(tag);
use Spelling;
-use Tags;
use Util;
# Supported documentation formats for doc-base files.
diff --git a/checks/nmu b/checks/nmu
index 51fc6f6..fd2febf 100644
--- a/checks/nmu
+++ b/checks/nmu
@@ -22,7 +22,7 @@ package Lintian::nmu;
use strict;
use Lintian::Data;
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
# Used to match Ubuntu distribution names in target distributions.
diff --git a/checks/patch-systems b/checks/patch-systems
index 36bf55d..4a22b8a 100644
--- a/checks/patch-systems
+++ b/checks/patch-systems
@@ -22,7 +22,7 @@
package Lintian::patch_systems;
use strict;
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
sub run {
diff --git a/checks/po-debconf b/checks/po-debconf
index 67b32bc..63fa55e 100644
--- a/checks/po-debconf
+++ b/checks/po-debconf
@@ -20,8 +20,8 @@
package Lintian::po_debconf;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/rules b/checks/rules
index 32da301..ef5eb54 100644
--- a/checks/rules
+++ b/checks/rules
@@ -15,8 +15,8 @@
package Lintian::rules;
use strict;
-use Tags;
use Util;
+use Lintian::Tags qw(tag);
# The allowed Python dependencies currently. This is the list of alternatives
# that, either directly or through transitive dependencies that can be relied
diff --git a/checks/scripts b/checks/scripts
index 97282c5..62aaef4 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -27,10 +27,11 @@ use strict;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
-use Tags;
+
use Util;
use Lintian::Relation;
+use Lintian::Tags qw(tag);
# This is a map of all known interpreters. The key is the interpreter name
# (the binary invoked on the #! line). The value is an anonymous array of one
diff --git a/checks/shared-libs b/checks/shared-libs
index b7727db..4c0e870 100644
--- a/checks/shared-libs
+++ b/checks/shared-libs
@@ -25,7 +25,7 @@ use File::Basename;
use Lintian::Data;
use Lintian::Relation;
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
# Libraries that should only be used in the presence of certain capabilities
diff --git a/checks/standards-version b/checks/standards-version
index 1f367f2..96c46fe 100644
--- a/checks/standards-version
+++ b/checks/standards-version
@@ -25,7 +25,7 @@ use strict;
use POSIX qw(strftime);
use Lintian::Data;
-use Tags;
+use Lintian::Tags qw(tag);
use Util;
our $STANDARDS = Lintian::Data->new('standards-version/release-dates', '\s+');
diff --git a/checks/version-substvars b/checks/version-substvars
index d1d0c69..5aa0f8e 100644
--- a/checks/version-substvars
+++ b/checks/version-substvars
@@ -36,7 +36,7 @@ package Lintian::version_substvars;
use strict;
use Util;
-use Tags;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/checks/watch-file b/checks/watch-file
index 85cf6ce..a9f4bfa 100644
--- a/checks/watch-file
+++ b/checks/watch-file
@@ -24,7 +24,7 @@ package Lintian::watch_file;
use strict;
use Lintian::Collect;
-use Tags;
+use Lintian::Tags qw(tag);
sub run {
diff --git a/debian/changelog b/debian/changelog
index 3e2fb0e..abb8316 100755
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,7 @@
lintian (2.2.19) UNRELEASED; urgency=low
+ * checks/*:
+ + [RA] Use Lintian::Tags instead of Tags.
* checks/binaries:
+ [RA] Allow any RPATH containing $ORIGIN or ${ORIGIN}, not just the
literal value $ORIGIN. (Closes: #557511)
@@ -16,7 +18,20 @@ lintian (2.2.19) UNRELEASED; urgency=low
completely suppress the given tags.
+ [RA] Support comments and blank lines in --tags-from-file files.
+ [RA] Run the check modules in sorted order.
+ + [RA] Create a global Lintian::Tags object and use it instead of
+ setting variables in the Tags namespace. Move display level code
+ from here to Lintian::Tags. Adjust calls for the new Lintian::Tags
+ module.
+ * lib/Lintian/Check.pm:
+ + [RA] Use Lintian::Tags instead of Tags.
+ * lib/Lintian/Output.pm:
+ + [RA] print_tag() now takes an additional argument containing
+ override data and expects a Lintian::Tag::Info object as the tag
+ info instead of a hash.
+ + [RA] Adjust for the renaming of pkg in the file information hash.
+ * lib/Lintian/Output/*.pm:
+ + [RA] Adjust for print_tag() and file information hash changes.
* lib/Lintian/Tag/Info.pm:
+ [RA] Add a code method that returns the tag code corresponding to
the severity and certainty for a tag, based on get_tag_code from
@@ -27,8 +42,15 @@ lintian (2.2.19) UNRELEASED; urgency=low
accessor method for it.
+ [RA] Add a sources method returning a list of sources referenced by
a tag, based on the get_tag_source method from Tags.pm.
- * lib/Tags.pm:
+ * lib/Lintian/Tags.pm:
+ + [RA] New module in a proper namespace replacing Tags.pm. A global
+ Lintian::Tags object replaces the static variables in the Tags
+ namespace, with new accessor functions, except for the tag metadata
+ functions (which have moved to Lintian::Tag::Info). All handling of
+ display levels is now here instead of in frontend/lintian.
+ [RA] Support suppressing a list of tags.
+ * lib/Spelling.pm:
+ + [RA] Use Lintian::Tags instead of Tags.
* lib/Util.pm:
+ [RA] Consume all output from extracting the control file of a binary
package before closing the pipe.
diff --git a/frontend/lintian b/frontend/lintian
index c3318a5..434ba8f 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -70,7 +70,7 @@ my $experimental_output_opts = undef;
my @severities = qw(wishlist minor normal important serious);
my @certainties = qw(wild-guess possible certain);
-my %display_level = ();
+my @display_level;
my %display_source = ();
my %suppress_tags = ();
@@ -316,24 +316,24 @@ sub record_pkgmode {
# Process -L|--display-level flag
sub record_display_level {
- my $level = $_[1];
- if ($level =~ m/^\+(.+)/) {
- set_display_level($1, 1);
- } elsif ($level =~ m/^\-(.+)/) {
- set_display_level($1, 0);
- } elsif ($level =~ m/^\=?(.+)/) {
- reset_display_level();
- set_display_level($1, 1);
- } else {
- die "invalid argument to --display-level: $level\n";
+ my ($option, $level) = @_;
+ my ($op) = ($level =~ s/^([+=-])//);
+ my ($rel) = ($level =~ s/^([<>]=?|=)//);
+ my ($severity, $certainty) = split('/', $level);
+ $op = '=' unless defined $op;
+ $rel = '=' unless defined $rel;
+ if (not defined $certainty) {
+ if (grep { $severity eq $_ } qw(wild-guess possible certain)) {
+ $certainty = $severity;
+ undef $severity;
+ }
}
+ push(@display_level, [ $op, $rel, $severity, $certainty ]);
}
# Process -I|--display-info flag
sub display_infotags {
- foreach my $s (@severities) {
- set_display_level($s, 1);
- }
+ push(@display_level, [ '+', '>=', 'wishlist' ]);
}
# Process --display-source flag
@@ -341,94 +341,6 @@ sub record_display_source {
$display_source{$_[1]} = 1;
}
-# Clears current display level information, disabling all severities and
-# certainties
-sub reset_display_level {
- foreach my $s (@severities) {
- foreach my $c (@certainties) {
- $display_level{$s}{$c} = 0;
- }
- }
-}
-
-sub set_display_level_multi {
- my ($op, $level, $val) = @_;
-
- my @inc_severities = @severities;
- my @inc_certainties = @certainties;
- my $inc_border = ($op =~ /^[<>]=$/) ? 1 : 0;
- if ($op =~ /^>/) {
- @inc_severities = reverse @inc_severities;
- @inc_certainties = reverse @inc_certainties;
- }
- my $severity = join("|", @severities);
- my $certainty = join("|", @certainties);
- if ($level =~ m/^($severity)$/) {
- foreach my $s (cut_list($level, $inc_border, @inc_severities)) {
- map { $display_level{$s}{$_} = $val } @certainties;
- }
- } elsif ($level =~ m/^($certainty)$/) {
- foreach my $c (cut_list($level, $inc_border, @inc_certainties)) {
- map { $display_level{$_}{$c} = $val } @severities;
- }
- } elsif ($level =~ m/^($severity)\/($certainty)$/) {
- foreach my $s (cut_list($1, $inc_border, @inc_severities)) {
- foreach my $c (cut_list($2, $inc_border, @inc_certainties)) {
- $display_level{$s}{$c} = $val;
- }
- }
- } else {
- die "invalid argument to --display-level: $level\n";
- }
-
-}
-
-sub cut_list {
- my ($border, $inc_border, @list) = @_;
-
- my (@newlist, $found);
- foreach (@list) {
- if ($_ eq $border) {
- push @newlist, $_ if $inc_border;
- $found = 1;
- last;
- } else {
- push @newlist, $_;
- }
- }
- die "internal error: cut_list did not find border $border\n"
- unless $found;
- if (!$inc_border and !...@newlist
- and $border eq $list[0]) {
- warn "warning: display level $border specified with > (or <) is empty
set, assuming >= (or <=)\n";
- push @newlist, $list[0];
- }
-
- return @newlist;
-}
-
-# Parse input display level to enable (val 1) or disable (val 0) it
-# accordingly
-sub set_display_level {
- my ($level, $val) = @_;
- if ($level =~ m/^([<>]=?)(.+)/) {
- set_display_level_multi($1, $2, $val);
- return;
- }
-
- my $severity = join("|", @severities);
- my $certainty = join("|", @certainties);
- if ($level =~ m/^($severity)$/) {
- map { $display_level{$1}{$_} = $val } @certainties;
- } elsif ($level =~ m/^($certainty)$/) {
- map { $display_level{$_}{$1} = $val } @severities;
- } elsif ($level =~ m/^($severity)\/($certainty)$/) {
- $display_level{$1}{$2} = $val;
- } else {
- die "invalid argument to --display-level: $level\n";
- }
-}
-
# Hash used to process commandline options
my %opthash = ( # ------------------ actions
"setup-lab|S" => \&record_action,
@@ -493,12 +405,6 @@ my %opthash = ( # ------------------
actions
"exp-output:s" => \$experimental_output_opts,
);
-# init display level settings
-reset_display_level();
-set_display_level_multi('>=', 'important', 1);
-set_display_level_multi('>=', 'normal/possible', 1);
-set_display_level('minor/certain', 1);
-
# init commandline parser
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
@@ -679,9 +585,6 @@ require Read_pkglists;
import Util;
-require Tags;
-import Tags;
-
require Lintian::Data;
require Lintian::Schedule;
require Lintian::Output;
@@ -690,6 +593,8 @@ require Lintian::Command;
import Lintian::Command qw(spawn reap);
require Lintian::Check;
import Lintian::Check qw(check_maintainer);
+require Lintian::Tags;
+import Lintian::Tags qw(tag);
no warnings 'once';
if (defined $experimental_output_opts) {
@@ -732,18 +637,19 @@ debug_msg(1,
delimiter(),
);
-my @l_secs = read_dpkg_control("$LINTIAN_ROOT/checks/lintian.desc");
-shift(@l_secs);
-map { $_->{'script'} = 'lintian'; Tags::add_tag($_) } @l_secs;
-
-$Tags::show_experimental = $display_experimentaltags;
-$Tags::show_pedantic = $display_pedantictags;
-$Tags::show_overrides = $show_overrides;
-%Tags::display_level = %display_level;
-%Tags::display_source = %display_source;
-%Tags::only_issue_tags = map { $_ => 1 } (split(/,/, $check_tags))
- if defined $check_tags;
-%Tags::suppress_tags = %suppress_tags;
+our $TAGS = Lintian::Tags->new;
+$TAGS->show_experimental($display_experimentaltags);
+$TAGS->show_pedantic($display_pedantictags);
+$TAGS->show_overrides($show_overrides);
+$TAGS->sources(keys %display_source) if %display_source;
+$TAGS->only(split(/,/, $check_tags)) if defined $check_tags;
+$TAGS->suppress(keys %suppress_tags) if %suppress_tags;
+
+# Initialize display level settings.
+for my $level (@display_level) {
+ $TAGS->display(@$level);
+}
+
use warnings;
# }}}
@@ -842,7 +748,7 @@ while (my $arg = shift) {
warning("$arg is a zero-byte file, skipping");
next;
}
- Tags::set_pkg( $arg, $arg_name, "", "", 'binary' );
+ $TAGS->file_start($arg, $arg_name, '', '', 'binary');
# If we don't have a Format key, something went seriously wrong.
# Tag the file and skip remaining processing.
@@ -984,7 +890,7 @@ while (my $arg = shift) {
}
unless ($exit_code) {
- my $stats = Tags::get_stats( $arg );
+ my $stats = $TAGS->statistics($arg);
if ($stats->{types}{E}) {
$exit_code = 1;
} elsif ($fail_on_warnings && $stats->{types}{W}) {
@@ -1230,9 +1136,7 @@ for my $f (readdir CHECKDIR) {
shift(@secs);
$p->{'requested-tags'} = 0;
foreach my $tag (@secs) {
- $tag->{'script'} = $script;
- Tags::add_tag($tag);
- $p->{'requested-tags'}++ if Tags::display_tag($tag);
+ $p->{'requested-tags'}++ if $TAGS->displayed($tag->{'tag'});
}
}
@@ -1262,10 +1166,10 @@ for my $c (keys %check_info) {
if ($action eq 'check') {
if ($check_tags) {
foreach my $t (split(/,/, $check_tags)) {
- my $info = Tags::get_tag_info($t);
+ my $info = Lintian::Tag::Info->new($t);
fail("unknown tag specified: $t") unless defined($info);
- my $script = $info->{'script'};
+ my $script = $info->script;
next if $script eq 'lintian';
if ($check_info{$script}) {
$checks{$script} = 1;
@@ -1390,7 +1294,7 @@ foreach my $pkg_info ($schedule->get_all) {
my $long_type = ($type eq 'b' ? 'binary' :
($type eq 's' ? 'source' : 'udeb' ));
- Tags::set_pkg( $file, $pkg, $ver, $arch, $long_type );
+ $TAGS->file_start($file, $pkg, $ver, $arch, $long_type);
# Kill pending jobs, if any
Lintian::Command::kill(@pending_jobs);
@@ -1566,8 +1470,7 @@ foreach my $pkg_info ($schedule->get_all) {
if ($action eq 'check') { # read override file
unless ($no_override) {
- Tags::add_overrides("$base/override", $pkg, $long_type)
- if (-f "$base/override")
+ $TAGS->file_overrides("$base/override") if -f "$base/override";
}
# perform checks
@@ -1606,7 +1509,7 @@ foreach my $pkg_info ($schedule->get_all) {
}
unless ($exit_code) {
- my $stats = Tags::get_stats( $file );
+ my $stats = $TAGS->statistics($file);
if ($stats->{types}{E}) {
$exit_code = 1;
} elsif ($fail_on_warnings && $stats->{types}{W}) {
@@ -1616,17 +1519,15 @@ foreach my $pkg_info ($schedule->get_all) {
# report unused overrides
if (not $no_override) {
- my $overrides = Tags::get_overrides( $file );
+ my $overrides = $TAGS->overrides($file);
for my $tag (sort keys %$overrides) {
- my $taginfo = Tags::get_tag_info{$tag};
- if (defined $taginfo) {
- # Did we run the check script containing the tag?
- next unless $checks{$taginfo->{'script'}};
+ next if $TAGS->suppressed($tag);
- # If only checking specific tags, is this one of them?
- next unless (scalar keys %Tags::only_issue_tags == 0)
- or exists $Tags::only_issue_tags{$tag};
+ # Did we run the check script containing the tag?
+ my $taginfo = Lintian::Tag::Info->new($tag);
+ if (defined $taginfo) {
+ next unless $checks{$taginfo->script};
}
for my $extra (sort keys %{$overrides->{$tag}}) {
@@ -1639,9 +1540,7 @@ foreach my $pkg_info ($schedule->get_all) {
# Report override statistics.
if (not $no_override and not $show_overrides) {
- my $stats = Tags::get_stats($file);
- my $short = $file;
- $short =~ s%.*/%%;
+ my $stats = $TAGS->statistics($file);
my $errors = $stats->{overrides}{types}{E} || 0;
my $warnings = $stats->{overrides}{types}{W} || 0;
my $info = $stats->{overrides}{types}{I} || 0;
@@ -1697,7 +1596,8 @@ foreach my $pkg_info ($schedule->get_all) {
close(STATUS);
}
}
-Tags::reset_pkg();
+$TAGS->file_end();
+
if ($action eq 'check' and not $no_override and not $show_overrides) {
my $errors = $overrides{errors} || 0;
my $warnings = $overrides{warnings} || 0;
diff --git a/lib/Lintian/Check.pm b/lib/Lintian/Check.pm
index 313e34f..d6bc7ef 100644
--- a/lib/Lintian/Check.pm
+++ b/lib/Lintian/Check.pm
@@ -24,7 +24,7 @@ use strict;
use warnings;
use Exporter ();
-use Tags qw(tag);
+use Lintian::Tags qw(tag);
our @ISA = qw(Exporter);
our @EXPORT = qw(check_maintainer);
diff --git a/lib/Lintian/Output.pm b/lib/Lintian/Output.pm
index e00e96c..12038a4 100644
--- a/lib/Lintian/Output.pm
+++ b/lib/Lintian/Output.pm
@@ -73,10 +73,11 @@ $Lintian::Output::GLOBAL unless their first argument
C<isa('Lintian::Output')>.
=cut
+use Lintian::Tag::Info ();
+use Lintian::Tags ();
+
# support for ANSI color output via colored()
use Term::ANSIColor ();
-use Lintian::Tag::Info ();
-use Tags ();
=head1 ACCESSORS
@@ -274,21 +275,23 @@ can only be called as instance methods.
=over 4
-=item C<print_tag($pkg_info, $tag_info, $extra)>
+=item C<print_tag($pkg_info, $tag_info, $extra, $overridden)>
-Print a tag. The first two arguments are hash reference with the information
-about the package and the tag, $extra is the extra information for the tag
-(if any) as an array reference. Called from Tags::tag().
+Print a tag. The first two arguments are hash reference with the
+information about the package and the tag, $extra is the extra information
+for the tag (if any) as an array reference, and $overridden is either
+undef if the tag is not overridden or the override for this tag. Called
+from Lintian::Tags::tag().
=cut
sub print_tag {
- my ($self, $pkg_info, $tag_info, $information) = @_;
+ my ($self, $pkg_info, $tag_info, $information, $overridden) = @_;
$information = ' ' . $information if $information ne '';
- my $code = Tags::get_tag_code($tag_info);
+ my $code = $tag_info->code;
my $tag_color = $self->{colors}{$code};
- $code = 'X' if exists $tag_info->{experimental};
- $code = 'O' if $tag_info->{overridden}{override};
+ $code = 'X' if $tag_info->experimental;
+ $code = 'O' if defined($overridden);
my $type = '';
$type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
@@ -301,26 +304,23 @@ sub print_tag {
$escaped =~ s/>/>/g;
$tag .= qq(<span style="color: $tag_color">$escaped</span>)
} else {
- $tag .= Term::ANSIColor::colored($tag_info->{tag}, $tag_color);
+ $tag .= Term::ANSIColor::colored($tag_info->tag, $tag_color);
}
} else {
- $tag .= $tag_info->{tag};
+ $tag .= $tag_info->tag;
}
- $self->_print('', "$code: $pkg_info->{pkg}$type", "$tag$information");
- if (!$self->issued_tag($tag_info->{tag}) and $self->showdescription) {
- my $info = Lintian::Tag::Info->new($tag_info->{tag});
- if ($info) {
- my $description;
- if ($self->_do_color && $self->color eq 'html') {
- $description = $info->description('html', ' ');
- } else {
- $description = $info->description('text', ' ');
- }
- $self->_print('', 'N', '');
- $self->_print('', 'N', split("\n", $description));
- $self->_print('', 'N', '');
+ $self->_print('', "$code: $pkg_info->{package}$type", "$tag$information");
+ if (!$self->issued_tag($tag_info->tag) and $self->showdescription) {
+ my $description;
+ if ($self->_do_color && $self->color eq 'html') {
+ $description = $tag_info->description('html', ' ');
+ } else {
+ $description = $tag_info->description('text', ' ');
}
+ $self->_print('', 'N', '');
+ $self->_print('', 'N', split("\n", $description));
+ $self->_print('', 'N', '');
}
}
@@ -335,14 +335,14 @@ sub print_start_pkg {
my ($self, $pkg_info) = @_;
$self->v_msg($self->delimiter,
- "Processing $pkg_info->{type} package $pkg_info->{pkg}
(version $pkg_info->{version}) ...");
+ "Processing $pkg_info->{type} package $pkg_info->{package}
(version $pkg_info->{version}) ...");
}
=item C<print_start_pkg($pkg_info)>
Called after lintian is finished with a package. The version in
-Lintian::Output does nothing. Called from Tags::select_pkg() and
-Tags::reset_pkg().
+Lintian::Output does nothing. Called from Lintian::Tags::file_start() and
+Lintian::Tags::file_end().
=cut
diff --git a/lib/Lintian/Output/ColonSeparated.pm
b/lib/Lintian/Output/ColonSeparated.pm
index aee8573..1e3e263 100644
--- a/lib/Lintian/Output/ColonSeparated.pm
+++ b/lib/Lintian/Output/ColonSeparated.pm
@@ -27,20 +27,20 @@ use Lintian::Output qw(:util);
use base qw(Lintian::Output);
sub print_tag {
- my ($self, $pkg_info, $tag_info, $information) = @_;
+ my ($self, $pkg_info, $tag_info, $information, $overridden) = @_;
- $self->issued_tag($tag_info->{tag});
+ $self->issued_tag($tag_info->tag);
$self->_print(
'tag',
- Tags::get_tag_code($tag_info),
- $tag_info->{severity},
- $tag_info->{certainty},
- (exists($tag_info->{experimental}) ? 'X' : '').
- ($tag_info->{overridden}{override} ? 'O' : ''),
- @{$pkg_info}{'pkg','version','arch','type'},
- $tag_info->{tag},
+ $tag_info->code,
+ $tag_info->severity,
+ $tag_info->certainty,
+ ($tag_info->experimental ? 'X' : '').
+ (defined($overridden) ? 'O' : ''),
+ @{$pkg_info}{'package','version','arch','type'},
+ $tag_info->tag,
$information,
- $tag_info->{overridden}{override} || '',
+ $overridden || '',
);
}
diff --git a/lib/Lintian/Output/LetterQualifier.pm
b/lib/Lintian/Output/LetterQualifier.pm
index 825da55..5275779 100644
--- a/lib/Lintian/Output/LetterQualifier.pm
+++ b/lib/Lintian/Output/LetterQualifier.pm
@@ -23,7 +23,6 @@ use warnings;
use Term::ANSIColor qw(colored);
use Lintian::Tag::Info ();
-use Tags ();
use Lintian::Output qw(:util);
use base qw(Lintian::Output);
@@ -104,20 +103,20 @@ sub new {
sub print_tag {
- my ($self, $pkg_info, $tag_info, $information) = @_;
+ my ($self, $pkg_info, $tag_info, $information, $overridden) = @_;
- my $code = Tags::get_tag_code($tag_info);
- $code = 'X' if exists $tag_info->{experimental};
- $code = 'O' if $tag_info->{overridden}{override};
+ my $code = $tag_info->code;
+ $code = 'X' if $tag_info->experimental;
+ $code = 'O' if defined($overridden);
- my $sev = $tag_info->{severity};
- my $cer = $tag_info->{certainty};
+ my $sev = $tag_info->severity;
+ my $cer = $tag_info->certainty;
my $lq = $codes{$sev}{$cer};
- my $pkg = $pkg_info->{pkg};
+ my $pkg = $pkg_info->{package};
my $type = ($pkg_info->{type} ne 'binary') ? " $pkg_info->{type}" : '';
- my $tag = $tag_info->{tag};
+ my $tag = $tag_info->tag;
$information = ' ' . $information if $information ne '';
@@ -128,14 +127,11 @@ sub print_tag {
}
$self->_print('', "$code\[$lq\]: $pkg$type", "$tag$information");
- if (!$self->issued_tag($tag_info->{tag}) and $self->showdescription) {
- my $info = Lintian::Tag::Info->new($tag_info->{tag});
- if ($info) {
- my $description = $info->description('text', ' ');
- $self->_print('', 'N', '');
- $self->_print('', 'N', split("\n", $description));
- $self->_print('', 'N', '');
- }
+ if (!$self->issued_tag($tag_info->tag) and $self->showdescription) {
+ my $description = $tag_info->description('text', ' ');
+ $self->_print('', 'N', '');
+ $self->_print('', 'N', split("\n", $description));
+ $self->_print('', 'N', '');
}
}
diff --git a/lib/Lintian/Output/XML.pm b/lib/Lintian/Output/XML.pm
index ff0ebc4..c113385 100644
--- a/lib/Lintian/Output/XML.pm
+++ b/lib/Lintian/Output/XML.pm
@@ -26,14 +26,14 @@ use Lintian::Output qw(:util);
use base qw(Lintian::Output);
sub print_tag {
- my ($self, $pkg_info, $tag_info, $information) = @_;
+ my ($self, $pkg_info, $tag_info, $information, $overridden) = @_;
- $self->issued_tag($tag_info->{tag});
+ $self->issued_tag($tag_info->tag);
$self->_print_xml('',
- qq{<tag severity="$tag_info->{severity}"
certainty="$tag_info->{certainty}"},
- 'flags="'.(exists($tag_info->{experimental}) ?
'experimental' : ''),
- ($tag_info->{overridden}{override} ? 'overridden' :
'').'"',
-
qq{name="$tag_info->{tag}">}.encode_entities("$information","<>&\"'").qq{</tag>},
+ qq{<tag severity="}, $tag_info->severity, qq{"
certainty="}, $tag_info->certainty, qq{"},
+ 'flags="'.($tag_info->experimental ? 'experimental' : ''),
+ ($overridden ? 'overridden' : '').'"',
+ qq{name="}, $tag_info->tag,
qq{">}.encode_entities("$information","<>&\"'").qq{</tag>},
);
}
@@ -41,7 +41,7 @@ sub print_start_pkg {
my ($self, $pkg_info) = @_;
$self->_print_xml('',
- qq{<package type="$pkg_info->{type}"
name="$pkg_info->{pkg}"},
+ qq{<package type="$pkg_info->{type}"
name="$pkg_info->{package}"},
qq{architecture="$pkg_info->{arch}"
version="$pkg_info->{version}">}
);
}
diff --git a/lib/Lintian/Tag/Info.pm b/lib/Lintian/Tag/Info.pm
index 1d7e72c..21844ba 100644
--- a/lib/Lintian/Tag/Info.pm
+++ b/lib/Lintian/Tag/Info.pm
@@ -306,7 +306,7 @@ Returns true if this tag is experimental, false otheriwse.
sub experimental {
my ($self) = @_;
- return $self->{experimental} eq 'yes';
+ return ($self->{experimental} and $self->{experimental} eq 'yes');
}
=item severity()
diff --git a/lib/Lintian/Tags.pm b/lib/Lintian/Tags.pm
index 54089c1..f2a3c12 100644
--- a/lib/Lintian/Tags.pm
+++ b/lib/Lintian/Tags.pm
@@ -189,17 +189,18 @@ called first or if an attempt is made to issue an unknown
tag.
# Check if a given tag with associated extra information is overridden by the
# overrides for the current file. This may require checking for matches
-# against override data with wildcards.
+# against override data with wildcards. Returns undef if the tag is not
+# overridden or the override if the tag is.
sub _check_overrides {
my ($self, $tag, $extra) = @_;
my $overrides = $self->{info}{$self->{current}}{overrides}{$tag};
return unless $overrides;
if (exists $overrides->{''}) {
$overrides->{''}++;
- return 1;
+ return $tag;
} elsif ($extra ne '' and exists $overrides->{$extra}) {
$overrides->{$extra}++;
- return 1;
+ return "$tag $extra";
} elsif ($extra ne '') {
for (sort keys %$overrides) {
my $pattern = $_;
@@ -209,20 +210,20 @@ sub _check_overrides {
$end = '.*' if $pattern =~ s/\*$//;
if ($extra =~ /^$start\Q$pattern\E$end\z/) {
$overrides->{$_}++;
- return 1;
+ return "$tag $_";
}
}
}
- return 0;
+ return;
}
# Record tag statistics. Takes the tag, the Lintian::Tag::Info object and a
# flag saying whether the tag was overridden.
sub _record_stats {
my ($self, $tag, $info, $overridden) = @_;
- my $stats = $self->{info}{$self->{current}};
+ my $stats = $self->{statistics}{$self->{current}};
if ($overridden) {
- $stats = $self->{info}{$self->{current}}{overrides};
+ $stats = $self->{statistics}{$self->{current}}{overrides};
}
$stats->{tags}{$tag}++;
$stats->{severity}{$info->severity}++;
@@ -238,12 +239,7 @@ sub tag {
unless ($self->{current}) {
die "tried to issue tag $tag without starting a file";
}
-
- # Ignore this tag if so configured.
- if (keys %{ $self->{only_issue} }) {
- return unless $self->{only_issue}{$tag};
- }
- return if $self->{suppress}{$tag};
+ return if $self->suppressed($tag);
# Clean up @extra and collapse it to a string. Lintian code
# doesn't treat the distinction between extra arguments to tag() as
@@ -260,8 +256,8 @@ sub tag {
}
my $overridden = $self->_check_overrides($tag, $extra);
$self->_record_stats($tag, $info, $overridden);
- return if ($overridden and not $self->{show_overrides});
- return unless $self->displayed($info);
+ return if (defined($overridden) and not $self->{show_overrides});
+ return unless $self->displayed($tag);
my $file = $self->{info}{$self->{current}};
$Lintian::Output::GLOBAL->print_tag($file, $info, $extra, $overridden);
}
@@ -309,7 +305,7 @@ certainty or an impossible constraint (like C<< > serious
>>).
# function makes a hard assumption that $rel will be one of <, <=, =, >=,
# or >. It is not syntax-checked.
sub _relation_subset {
- my ($element, $rel, @list) = @_;
+ my ($self, $element, $rel, @list) = @_;
if ($rel eq '=') {
return grep { $_ eq $element } @list;
}
@@ -323,7 +319,7 @@ sub _relation_subset {
last;
}
}
- return unless $found;
+ return unless defined($found);
if (length($rel) > 1) {
return @list[$found .. $#list];
} else {
@@ -358,9 +354,9 @@ sub display {
if (not defined $severity and not defined $certainty) {
die "invalid display constraint $op $rel";
} elsif (not defined $severity) {
- die "invalid display constraint $op $rel $certainty";
+ die "invalid display constraint $op $rel $certainty (certainty)";
} elsif (not defined $certainty) {
- die "invalid display constraint $op $rel $severity";
+ die "invalid display constraint $op $rel $severity (severity)";
} else {
die "invalid display constraint $op $rel $severity/$certainty";
}
@@ -663,6 +659,27 @@ sub displayed {
return $display;
}
+=item suppressed(TAG)
+
+Returns true if the given tag would be suppressed given the current
+configuration, false otherwise. This is different than displayed() in
+that a tag is only suppressed if Lintian treats the tag as if it's never
+been seen, doesn't update statistics, and doesn't change its exit status.
+Tags are suppressed via only() or suppress().
+
+=cut
+
+#'# for cperl-mode
+
+sub suppressed {
+ my ($self, $tag) = @_;
+ if (keys %{ $self->{only_issue} }) {
+ return 1 unless $self->{only_issue}{$tag};
+ }
+ return 1 if $self->{suppress}{$tag};
+ return;
+}
+
1;
# Local Variables:
diff --git a/lib/Spelling.pm b/lib/Spelling.pm
index 6dc6027..389ceef 100644
--- a/lib/Spelling.pm
+++ b/lib/Spelling.pm
@@ -21,7 +21,8 @@
package Spelling;
use strict;
-use Tags;
+
+use Lintian::Tags qw(tag);
use Exporter;
our @ISA = qw(Exporter);
diff --git a/private/transtats b/private/transtats
index 5b0ee75..9728bea 100755
--- a/private/transtats
+++ b/private/transtats
@@ -16,10 +16,10 @@ my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Read_pkglists;
-use Tags;
+use Lintian::Tag::Info;
-my @severities = @Tags::severity_list;
-my @certainties = @Tags::certainty_list;
+my @severities = qw(pedantic wishlist minor normal important serious);
+my @certainties = qw(wild-guess possible certain);
my @types = qw(info warning error);
my @codes = qw(I W E);
@@ -72,7 +72,8 @@ for my $check (readdir CHECKDIR) {
next if not $done;
my $old_code = $old_codes{$type};
- my $new_code = Tags::get_tag_code($tag);
+ my $info = Lintian::Tag::Info->new($tag);
+ my $new_code = $info->code;
push(@{$stats{code}{$old_code}{$new_code}}, $name);
$num_ok++ if $old_code eq $new_code;
diff --git a/t/scripts/tags.t b/t/scripts/tags.t
index 82a14e1..8ae048a 100755
--- a/t/scripts/tags.t
+++ b/t/scripts/tags.t
@@ -20,15 +20,17 @@
use strict;
use warnings;
+
use Test::More qw(no_plan);
-use Util qw(read_dpkg_control);
-use Tags ();
+
+use Lintian::Tags ();
use Spelling;
+use Util qw(read_dpkg_control);
my @DESCS = <$ENV{'LINTIAN_ROOT'}/checks/*.desc>;
-my %severities = map { $_ => 1 } @Tags::severity_list;
-my %certainties = map { $_ => 1 } @Tags::certainty_list;
+my %severities = map { $_ => 1 } 'pedantic', @Lintian::Tags::SEVERITIES;
+my %certainties = map { $_ => 1 } @Lintian::Tags::CERTAINTIES;
for my $desc_file (@DESCS) {
for my $i (read_dpkg_control($desc_file)) {
diff --git a/testset/runtests b/testset/runtests
index 00f7ab0..d3f8c06 100755
--- a/testset/runtests
+++ b/testset/runtests
@@ -113,8 +113,8 @@ BEGIN {
my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Lintian::Tag::Info;
use Util;
-use Tags;
# --- Set the ways to call lintian and dpkg-buildpackage
my $lintian_options = '-I -E';
@@ -140,7 +140,8 @@ for my $desc_file (<$LINTIAN_ROOT/checks/*.desc>) {
$desc_file =~ s#.*/##;
if (exists $i->{'tag'}) {
my $experimental = $i->{'experimental'};
- my $code = Tags::get_tag_code($i);
+ my $info = Lintian::Tag::Info->new($i->{tag});
+ my $code = $info->code;
$code = 'X' if $experimental and $experimental eq 'yes';
$tags{$i->{'tag'}}{'desc_file'} = $desc_file;
--
Debian package checker
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
