[SCM] Debian package checker branch, master, updated. 2.5.4-115-g3e2aa2a
The following commit has been merged in the master branch:
commit 2345d59bc2bf1997f71dc8b48a91269e128cec59
Author: Niels Thykier <niels@thykier.net>
Date: Tue Jan 17 19:35:38 2012 +0100
Made profiles a "tag-container" and use profiles more widely
Previously tags were stored in a private static variable in
Lintian::Tags. Unfortunately, Lintian::Tags, Lintian::Profile and
reporting/html_reports manually accessed the check dir for various
reasons.
To solve this, Lintian::Profile is now the primary method of obtaining
tag info. There is a single unhandled case in f/lintian (propagating
to Lintian::Tags), where no profile is loaded and the old method is
still used.
Some important changes:
* Lintian::Profile now applies severity changes directly.
* Lintian::Tags can work directly with a profile, which reduces a bit
of glue code between the two modules in f/lintian.
* The (reporting) templates now get the Lintian profile (as $profile).
This replaces the "%all" hash (only used to iterate over all known
tags in r/t/tags-all.tmpl).
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/frontend/lintian b/frontend/lintian
index 723e39f..00d2735 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -748,7 +748,6 @@ require Lintian::Internal::FrontendUtil;
import Lintian::Internal::FrontendUtil;
require Lintian::ProcessablePool;
require Lintian::Profile;
-require Lintian::Tag::Info;
require Lintian::Tags;
import Lintian::Tags qw(tag);
@@ -791,6 +790,7 @@ debug_msg(1,
delimiter(),
);
+my $PROFILE;
our $TAGS = Lintian::Tags->new;
$TAGS->show_experimental($opt{'display-experimental'});
$TAGS->show_pedantic($opt{'pedantic'});
@@ -821,18 +821,10 @@ if ($no_profile) {
}
if ($opt{'LINTIAN_PROFILE'}) {
- my $profile = Lintian::Profile->new($opt{'LINTIAN_PROFILE'},
+ $PROFILE = Lintian::Profile->new ($opt{'LINTIAN_PROFILE'},
[@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles"]);
- my @ptags = $profile->tags;
- my @non_overridable = $profile->non_overridable_tags;
- my $severities = $profile->severity_changes;
- v_msg('Using profile ' . $profile->name . '.');
- $TAGS->only(@ptags) if @ptags;
- $TAGS->non_overridable_tags(@non_overridable) if @non_overridable;
- while ( my ($tagname, $severity) = each(%$severities) ){
- my $tag = Lintian::Tag::Info->new($tagname);
- $tag->set_severity($severity);
- }
+ v_msg('Using profile ' . $PROFILE->name . '.');
+ $TAGS->profile ($PROFILE);
}
# Initialize display level settings.
@@ -1043,7 +1035,14 @@ if ($action eq 'check') {
if ($check_tags) {
foreach my $t (split(/,/, $check_tags)) {
- my $info = Lintian::Tag::Info->new($t);
+ my $info;
+ if ($PROFILE) {
+ # At the time of writing (2012-17/01) this code path is
+ # not possible, but one day it may be.
+ $info = $PROFILE->get_tag ($t);
+ } else {
+ $info = Lintian::Tag::Info->new ($t);
+ }
fail("unknown tag specified: $t") unless defined($info);
my $script = $info->script;
@@ -1422,7 +1421,12 @@ sub post_pkg_process_overrides{
next if $TAGS->suppressed($tag);
# Did we run the check script containing the tag?
- my $taginfo = Lintian::Tag::Info->new($tag);
+ my $taginfo;
+ if ($PROFILE) {
+ $taginfo = $PROFILE->get_tag ($tag);
+ } else {
+ $taginfo = Lintian::Tag::Info->new($tag);
+ }
if (defined $taginfo) {
next unless $enabled_checks{$taginfo->script};
}
diff --git a/frontend/lintian-info b/frontend/lintian-info
index 6a8b24a..7a7da3c 100755
--- a/frontend/lintian-info
+++ b/frontend/lintian-info
@@ -39,7 +39,6 @@ BEGIN {
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Internal::FrontendUtil;
use Lintian::Profile;
-use Lintian::Tag::Info ();
use Text_utils;
my %already_displayed = ();
@@ -49,6 +48,7 @@ my @proc_inc = (
"$ENV{'LINTIAN_ROOT'}/profiles"
);
my ($annotate, $tags, $help, $prof);
+my $profile;
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
GetOptions(
'annotate|a' => \$annotate,
@@ -77,7 +77,7 @@ unless ($prof) {
$prof = find_default_profile(@proc_inc);
}
-load_profile($prof, \@proc_inc);
+$profile = Lintian::Profile->new($prof, \@proc_inc);
# If tag mode was specified, read the arguments as tags and display the
# descriptions for each one. (We don't currently display the severity,
@@ -85,7 +85,7 @@ load_profile($prof, \@proc_inc);
my $unknown;
if ($tags) {
for my $tag (@ARGV) {
- my $info = Lintian::Tag::Info->new($tag);
+ my $info = $profile->get_tag ($tag, 1);
if ($info) {
print $info->code . ": $tag\n";
print "N:\n";
@@ -144,7 +144,7 @@ while (<>) {
$tag = $1;
}
next if $already_displayed{$tag}++;
- my $info = Lintian::Tag::Info->new($tag);
+ my $info = $profile->get_tag ($tag, 1);
next unless $info;
print "N:\n";
print $info->description('text', 'N: ');
@@ -153,19 +153,6 @@ while (<>) {
exit 0;
-# load_profile($profname, $proc_inc_ref)
-# Loads the profile called $profname and applies
-# the relevant changes from it.
-sub load_profile{
- my ($profname, $proc_inc_ref) = @_;
- my $profile = Lintian::Profile->new($prof, $proc_inc_ref);
- my $severities = $profile->severity_changes;
- while ( my ($tagname, $severity) = each(%$severities) ){
- my $tag = Lintian::Tag::Info->new($tagname);
- $tag->set_severity($severity);
- }
-}
-
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/lib/Lintian/Output.pm b/lib/Lintian/Output.pm
index 4077e3d..c68eb0a 100644
--- a/lib/Lintian/Output.pm
+++ b/lib/Lintian/Output.pm
@@ -73,7 +73,6 @@ $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()
diff --git a/lib/Lintian/Profile.pm b/lib/Lintian/Profile.pm
index 2f8d337..ed0553f 100644
--- a/lib/Lintian/Profile.pm
+++ b/lib/Lintian/Profile.pm
@@ -27,6 +27,8 @@ use warnings;
use Carp qw(croak);
use Util qw(read_dpkg_control);
+use Lintian::CheckScript;
+
=head1 NAME
Lintian::Profile - Profile parser for Lintian
@@ -55,10 +57,6 @@ Lintian::Profile - Profile parser for Lintian
=cut
-# maps tag name to tag data.
-my %TAG_MAP = ();
-# maps check name to list of tag names.
-my %CHECK_MAP = ();
# map of known valid severity allowed by profiles
my %SEVERITIES = (
'pedantic' => 1,
@@ -86,32 +84,6 @@ my %SEC_FIELDS = (
'severity' => 1,
);
-# _load_checks
-#
-# Internal sub to load and fill up %TAG_MAP and %CHECK_MAP
-sub _load_checks {
- my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
- for my $desc (<$root/checks/*.desc>) {
- my ($header, @tags) = read_dpkg_control($desc);
- my $cname = $header->{'check-script'};
- my $tagnames = [];
- unless ($cname){
- croak "Missing Check-Script field in $desc.\n";
- }
- $CHECK_MAP{$cname} = $tagnames;
- for my $tag (@tags) {
- unless ($tag->{tag}) {
- croak "Missing Tag field in $desc.\n";
- }
- push @$tagnames, $tag->{tag};
- $tag->{info} = '' unless exists($tag->{info});
- $tag->{script} = $header->{'check-script'};
- $TAG_MAP{$tag->{tag}} = $tag;
- }
- }
-}
-
-
=item Lintian::Profile->new($profname, $ppath)
Creates a new profile from the profile located by
@@ -127,7 +99,6 @@ sub new {
my $profile;
croak "Illegal profile name \"$name\".\n"
if $name =~ m,^/,o or $name =~ m/\./o;
- _load_checks() unless %TAG_MAP;
my $self = {
'parent-map' => {},
'parents' => [],
@@ -135,6 +106,8 @@ sub new {
'enabled-tags' => {},
'non-overridable-tags' => {},
'severity-changes' => {},
+ 'check-scripts' => {},
+ 'known-tags' => {},
};
$self = bless $self, $type;
$profile = $self->find_profile($name);
@@ -160,46 +133,46 @@ to create this instance of the profile (e.g. due to symlinks).
Lintian::Profile->mk_ro_accessors (qw(parents name));
-=item $prof->tags
+=item $prof->tags([$known])
-Returns the list of tags enabled in this profile.
+Returns the list of tags in this profile. If $known is given
+and it is a truth value, the list of known tags is returned.
+Otherwise only the enabled tags will be returned.
Note: The contents of this list should not be modified.
=cut
sub tags {
- my ($self) = @_;
+ my ($self, $known) = @_;
+ return keys %{ $self->{'known-tags'} } if $known;
return keys %{ $self->{'enabled-tags'} };
}
-=item $prof->severity_changes
+=item $prof->is_overridable ($tag)
-Returns a hashref mapping tag names to their altered severity. If an
-enabled tag is not present in this hashref, then it uses its normal
-severity. The altered severity may be the same as the normal
-severity.
-
-Note: Neither hashref nor its contents should be altered.
+Returns a false value if the tag has been marked as
+"non-overridable". Otherwise it returns a truth value.
=cut
-sub severity_changes {
- my ($self) = @_;
- return $self->{'severity-changes'};
+sub is_overridable {
+ my ($self, $tag) = @_;
+ return ! exists $self->{'non-overridable-tags'}->{$tag};
}
-=item $prof->non_overridable_tags
-
-List of tags that has been marked as non-overridable.
+=item $prof->get_tag ($tag[, $known])
-Note: Neither list nor its contents should be modified.
+Returns the Lintian::Tag::Info for $tag if it is enabled for the
+profile (or just a "known tag" if $known is given and a truth value).
+Otherwise it returns undef.
=cut
-sub non_overridable_tags {
- my ($self) = @_;
- return keys %{ $self->{'non-overridable-tags'} };
+sub get_tag {
+ my ($self, $tag, $known) = @_;
+ return unless $known || exists $self->{'enabled-tags'}->{$tag};
+ return $self->{'known-tags'}->{$tag};
}
=item Lintian::Profile->find_profile($pname, @dirs), $prof->find_profile($pname[, @dirs])
@@ -301,8 +274,11 @@ sub _read_profile_section {
croak "Profile \"$pname\" contains invalid severity \"$severity\" in section $sno.\n"
if $severity && !$SEVERITIES{$severity};
foreach my $tag (@tags) {
- croak "Unknown check $tag in $pname (section $sno).\n" unless exists $TAG_MAP{$tag};
- $sev_map->{$tag} = $severity if $severity;
+ croak "Unknown check $tag in $pname (section $sno).\n" unless $self->{'known-tags'}->{$tag};
+ if ($severity) {
+ $self->{'known-tags'}->{$tag}->set_severity ($severity);
+ $sev_map->{$tag} = $severity;
+ }
if ( $overridable != -1 ) {
if ($overridable) {
delete $noover->{$tag};
@@ -329,12 +305,19 @@ sub _read_profile_tags{
$self->_check_duplicates($pname, $pheader, 'enable-tags', 'disable-tags');
my $tags_from_check_sub = sub {
my ($field, $check) = @_;
- croak "Unknown check \"$check\" in profile \"$pname\".\n" unless exists $CHECK_MAP{$check};
- return @{$CHECK_MAP{$check}};
+
+ unless (exists $self->{'check-scripts'}->{$check}) {
+ $self->_load_check ($pname, $check);
+ }
+ return $self->{'check-scripts'}->{$check}->tags;
};
my $tag_sub = sub {
my ($field, $tag) = @_;
- croak "Unknown tag \"$tag\" in profile \"$pname\".\n" unless exists $TAG_MAP{$tag};
+ unless (exists $self->{'known-tags'}->{$tag}) {
+ $self->_load_checks($pname);
+ croak "Unknown tag \"$tag\" in profile \"$pname\".\n"
+ unless exists $self->{'known-tags'}->{$tag};
+ }
return $tag;
};
$self->_enable_tags_from_field($pname, $pheader, 'enable-tags-from-check', $tags_from_check_sub, 1);
@@ -430,6 +413,34 @@ sub _check_for_invalid_fields {
}
}
+sub _load_check {
+ my ($self, $profile, $check) = @_;
+ my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
+ my $cf = "$root/checks/${check}.desc";
+ croak "$profile references unknown $check.\n" unless -f $cf;
+ my $c = Lintian::CheckScript->new ($cf);
+ return if $self->{'check-scripts'}->{$c->name};
+ $self->{'check-scripts'}->{$c->name} = $c;
+ for my $tn ($c->tags) {
+ if ($self->{'known-tags'}->{$tn}) {
+ my $ocn = $self->{'known-tags'}->{$tn}->script;
+ croak $c->name . " redefined tag $tn which was defined by $ocn";
+ }
+ $self->{'known-tags'}->{$tn} = $c->get_tag ($tn);
+ }
+}
+
+sub _load_checks {
+ my ($self, $profile) = @_;
+ my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
+ opendir my $dirfd, "$root/checks" or croak "opendir $root/checks: $!";
+ for my $desc (sort readdir $dirfd) {
+ next unless $desc =~ s/\.desc$//o;
+ $self->_load_check($profile, $desc);
+ }
+ close $dirfd;
+}
+
=back
=head1 AUTHOR
diff --git a/lib/Lintian/Tags.pm b/lib/Lintian/Tags.pm
index dad5e3e..c629884 100644
--- a/lib/Lintian/Tags.pm
+++ b/lib/Lintian/Tags.pm
@@ -118,6 +118,12 @@ created object.
# A hash of tags to issue. If this hash is not empty, only tags noted
# in that has will be issued regardless of which tags are seen.
#
+# profile:
+# The Lintian::Profile (if any). If not undef, this is used to
+# determine known tags, severity of tags (indirectly) and whether
+# or not a given tag is overridable. It also partly affects
+# which tags are suppressed (see the suppressed method below).
+#
# show_experimental:
# True if experimental tags should be displayed. False by default.
#
@@ -155,9 +161,9 @@ sub new {
},
display_source => {},
files => {},
- non_overridable_tags => {},
ignored_overrides => {},
only_issue => {},
+ profile => undef,
show_experimental => 0,
show_overrides => 0,
show_pedantic => 0,
@@ -242,7 +248,14 @@ sub tag {
}
# Retrieve the tag metadata and display the tag if the configuration
# says to display it.
- my $info = Lintian::Tag::Info->new($tag);
+ my $info;
+ if ($self->{profile}) {
+ # Note, we get the known as it will be suppressed by
+ # $self->suppressed below if the tag is not enabled.
+ $info = $self->{profile}->get_tag ($tag, 1);
+ } else {
+ $info = Lintian::Tag::Info->new($tag);
+ }
unless ($info) {
die "tried to issue unknown tag $tag";
}
@@ -465,6 +478,23 @@ sub suppress {
}
}
+=item profile(PROFILE)
+
+Use the PROFILE (Lintian::Profile) to determine which tags are
+suppressed, the severity of the tags and which tags are
+non-overridable.
+
+This can be used together with suppress. In this case tags are
+only emitted if they are enabled in the profile AND they are not
+suppressed.
+
+=cut
+
+sub profile {
+ my ($self, $profile) = @_;
+ $self->{profile} = $profile;
+}
+
=back
=head2 File Metadata
@@ -527,7 +557,7 @@ file cannot be opened.
sub file_overrides {
my ($self, $overrides) = @_;
- my $noover = $self->{non_overridable_tags};
+ my $profile = $self->{profile};
unless (defined $self->{current}) {
die 'no current file when adding overrides';
}
@@ -601,7 +631,7 @@ sub file_overrides {
}
next unless $found;
}
- if ( $noover->{$tag} ) {
+ if ( $profile && !$profile->is_overridable ($tag) ) {
$self->{ignored_overrides}{$tag}++;
next;
}
@@ -719,7 +749,14 @@ configuration.
sub displayed {
my ($self, $tag) = @_;
- my $info = Lintian::Tag::Info->new($tag);
+ my $info;
+ if ($self->{profile}) {
+ # Note, we get the known as it will be suppressed by
+ # $self->suppressed below if the tag is not enabled.
+ $info = $self->{profile}->get_tag ($tag, 1);
+ } else {
+ $info = Lintian::Tag::Info->new($tag);
+ }
return 0 if ($info->experimental and not $self->{show_experimental});
my $only = $self->{only_issue};
if (%$only) {
@@ -762,7 +799,7 @@ 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().
+Tags are suppressed via only(), profile() or suppress().
=cut
@@ -774,24 +811,10 @@ sub suppressed {
return 1 unless $self->{only_issue}{$tag};
}
return 1 if $self->{suppress}{$tag};
+ return 1 if $self->{profile} and not $self->{profile}->get_tag ($tag);
return;
}
-=item non_overridable_tags(TAG[, ...])
-
-Marks all tags (given as arguments) for non-overridable.
-
-=cut
-
-sub non_overridable_tags {
- my ($self, @tags) = @_;
- my $noover = $self->{non_overridable_tags};
- foreach my $tag (@tags){
- $noover->{$tag} = 1;
- }
- return 1;
-}
-
=item ignored_overrides()
Returns a hash of tags, for which overrides have been ignored. The
diff --git a/reporting/html_reports b/reporting/html_reports
index 9da9317..820f0f3 100755
--- a/reporting/html_reports
+++ b/reporting/html_reports
@@ -52,37 +52,13 @@ $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT;
use lib "$ENV{LINTIAN_ROOT}/lib";
use Lintian::Lab;
use Lintian::Profile;
-use Lintian::Tag::Info ();
use Lintian::Internal::FrontendUtil;
use Text_utils;
use Util;
-# Get additional tag information.
-our %tag_info = ();
-
-opendir(CHECKDIR, "$LINTIAN_ROOT/checks")
- or fail("cannot read directory $LINTIAN_ROOT/checks");
-
-for my $check (readdir CHECKDIR) {
- next unless $check =~ /\.desc$/;
- my @tags = read_dpkg_control("$LINTIAN_ROOT/checks/$check");
- shift(@tags);
- foreach my $tag (@tags) {
- next unless $tag->{severity} and $tag->{certainty};
- my $name = $tag->{tag};
- $tag_info{$name} = Lintian::Tag::Info->new ($name);
- }
-}
-
-closedir(CHECKDIR);
-
my $profile = Lintian::Profile->new (find_default_profile ("$LINTIAN_ROOT/profiles"),
["$LINTIAN_ROOT/profiles"]);
-while ( my ($tagname, $severity) = each (%{$profile->severity_changes}) ) {
- my $tag = $tag_info{$tagname};
- $tag->set_severity ($severity);
-}
# Set the Lintian version, current timestamp, and archive timestamp.
our $LINTIAN_VERSION = `$LINTIAN_ROOT/frontend/lintian --print-version`;
@@ -226,7 +202,7 @@ while (<>) {
next unless ($type eq 'source' || $type eq 'binary' || $type eq 'udeb');
# Ignore unknown tags - happens if we removed a tag that is still present
# in the log file.
- next unless $tag_info{$tag};
+ next unless $profile->get_tag ($tag, 1);
# Update statistics.
my $key = {
@@ -311,8 +287,8 @@ while (<>) {
area => html_quote ($area),
type => html_quote ($type),
tag => html_quote ($tag),
- severity => html_quote ($tag_info{$tag}->severity),
- certainty => html_quote ($tag_info{$tag}->certainty),
+ severity => html_quote ($profile->get_tag ($tag, 1)->severity),
+ certainty => html_quote ($profile->get_tag ($tag, 1)->certainty),
extra => html_quote ($extra),
xref => maintainer_url ($maintainer) . "#$source"
};
@@ -480,8 +456,8 @@ for my $id (keys %clean) {
# Create the pages for each tag. Each page shows the extended description for
# the tag and all the packages for which that tag was issued.
-for my $tag (sort keys %tag_info) {
- my $info = $tag_info{$tag};
+for my $tag (sort $profile->tags (1)) {
+ my $info = $profile->get_tag ($tag, 1);
my $description = $info->description('html', ' ');
my ($count, $overrides) = (0, 0);
my %seen_tags;
@@ -514,7 +490,7 @@ for my $tag (sort keys %tag_info) {
%data = (
tags => \%by_tag,
stats => \%tag_statistics,
- all => \%tag_info,
+ profile => \$profile,
);
output_template ('tags.html', $templates{tags}, \%data);
output_template ('tags-severity.html', $templates{'tags-severity'}, \%data);
diff --git a/reporting/templates/tags-all.tmpl b/reporting/templates/tags-all.tmpl
index 84dcd3e..a88457b 100644
--- a/reporting/templates/tags-all.tmpl
+++ b/reporting/templates/tags-all.tmpl
@@ -8,7 +8,7 @@
<ul>
{
- for my $tag (sort keys %all) {
+ for my $tag (sort $profile->tags (1)) {
my $text;
if ($stats{$tag}) {
my $packages = $stats{$tag}{'packages'};
--
Debian package checker
Reply to: