[SCM] Debian package checker branch, master, updated. 2.5.4-115-g3e2aa2a
The following commit has been merged in the master branch:
commit 6837afa3218bf708d45d7f769dfb2172f7920f04
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jan 18 01:05:26 2012 +0100
Always load a profile and stop using Lintian::Info::Tag (TAG)
frontend/lintian will now always load a profile. This allows
all tag look-ups to go through profiles and removes the need
for the Lintian::Info::Tag (TAG) constructor.
In order to keep this patch small, it leaves some now (almost)
redundant code that will be removed in a later commit (notiably
including the above mentioned constructor).
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/frontend/lintian b/frontend/lintian
index 00d2735..07284b8 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -100,7 +100,6 @@ my $packages_file = 0; #string for the -p option
my $no_conf = 0; #flag for --no-cfg
my %opt; #hash of some flags from cmd or cfg
my %conf_opt; #names of options set in the cfg file
-my $no_profile = 0; #whether a profile should be loaded
my %group_cache = (); # Cache to store groups in case of group
# queries
@@ -264,7 +263,6 @@ sub record_check_part {
}
$action = 'check';
$checks = "$_[1]";
- $no_profile = 1;
}
# Record Parts requested for checking
@@ -284,7 +282,6 @@ sub record_check_tags {
}
$action = 'check';
$check_tags = "$_[1]";
- $no_profile = 1;
}
# Record Parts requested for checking
@@ -796,15 +793,21 @@ $TAGS->show_experimental($opt{'display-experimental'});
$TAGS->show_pedantic($opt{'pedantic'});
$TAGS->show_overrides($opt{'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;
-if ($no_profile) {
- # No profile if we have been given explicit list
- $opt{'LINTIAN_PROFILE'} = '';
- # if tags are listed explicitly (--tags) then show them even if
- # they are pedantic/experimental etc. However, for --check-part
- # people explictly have to pass the relevant options.
+unless ($opt{'LINTIAN_PROFILE'}){
+ # Time to ask dpkg-vendor for a vendor name
+ $opt{'LINTIAN_PROFILE'} = find_default_profile(@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles");
+}
+$PROFILE = Lintian::Profile->new ($opt{'LINTIAN_PROFILE'},
+ [@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles"]);
+v_msg('Using profile ' . $PROFILE->name . '.');
+
+# if tags are listed explicitly (--tags) then show them even if
+# they are pedantic/experimental etc. However, for --check-part
+# people explictly have to pass the relevant options.
+if ($checks || $check_tags) {
+ $PROFILE->disable_tags ($PROFILE->tags);
if ($check_tags) {
$TAGS->show_experimental(1);
$TAGS->show_pedantic(1);
@@ -812,20 +815,24 @@ if ($no_profile) {
# everything
@display_level = ();
display_infotags();
- }
-} else {
- unless ($opt{'LINTIAN_PROFILE'}){
- # Time to ask dpkg-vendor for a vendor name
- $opt{'LINTIAN_PROFILE'} = find_default_profile(@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles");
+ $PROFILE->enable_tags (split /,/, $check_tags);
+ } else {
+ my %abbrev = ();
+ for my $c ($PROFILE->scripts (1)) {
+ my $cs = $PROFILE->get_script ($c, 1);
+ next unless $cs->abbrev;
+ $abbrev{$cs->abbrev} = $cs;
+ }
+ for my $c (split /,/, $checks) {
+ my $cs = $PROFILE->get_script ($c, 1) || $abbrev{$c};
+ fail ("Unknown check script $c") unless $cs;
+ $PROFILE->enable_tags ($cs->tags);
+ }
}
}
-if ($opt{'LINTIAN_PROFILE'}) {
- $PROFILE = Lintian::Profile->new ($opt{'LINTIAN_PROFILE'},
- [@prof_inc, "$opt{'LINTIAN_ROOT'}/profiles"]);
- v_msg('Using profile ' . $PROFILE->name . '.');
- $TAGS->profile ($PROFILE);
-}
+$TAGS->profile ($PROFILE);
+
# Initialize display level settings.
for my $level (@display_level) {
@@ -1035,14 +1042,7 @@ if ($action eq 'check') {
if ($check_tags) {
foreach my $t (split(/,/, $check_tags)) {
- 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);
- }
+ my $info = $PROFILE->get_tag ($t);
fail("unknown tag specified: $t") unless defined($info);
my $script = $info->script;
@@ -1421,12 +1421,8 @@ sub post_pkg_process_overrides{
next if $TAGS->suppressed($tag);
# Did we run the check script containing the tag?
- my $taginfo;
- if ($PROFILE) {
- $taginfo = $PROFILE->get_tag ($tag);
- } else {
- $taginfo = Lintian::Tag::Info->new($tag);
- }
+ my $taginfo = $PROFILE->get_tag ($tag);
+
if (defined $taginfo) {
next unless $enabled_checks{$taginfo->script};
}
diff --git a/lib/Lintian/Profile.pm b/lib/Lintian/Profile.pm
index ed0553f..9449fe8 100644
--- a/lib/Lintian/Profile.pm
+++ b/lib/Lintian/Profile.pm
@@ -103,11 +103,12 @@ sub new {
'parent-map' => {},
'parents' => [],
'profile-path' => $ppath,
- 'enabled-tags' => {},
+ 'enabled-tags' => {}, # "set" of tags enabled (value is largely ignored)
+ 'enabled-checks' => {}, # maps script to the number of tags enabled (0 if disabled)
'non-overridable-tags' => {},
'severity-changes' => {},
- 'check-scripts' => {},
- 'known-tags' => {},
+ 'check-scripts' => {}, # maps script name to Lintian::CheckScript
+ 'known-tags' => {}, # maps tag name to Lintian::Tag::Info
};
$self = bless $self, $type;
$profile = $self->find_profile($name);
@@ -149,6 +150,22 @@ sub tags {
return keys %{ $self->{'enabled-tags'} };
}
+=item $prof->scripts ([$known])
+
+Returns the list of Check-Scripts in this profile. If $known
+is given and it is a turth value, the list of known Check-Scripts
+is returned. Otherwise only checks with an enabled tag will be
+enabled.
+
+=cut
+
+sub scripts {
+ my ($self, $known) = @_;
+ return keys %{ $self->{'check-scripts'} } if $known;
+ return grep { $self->{'enabled-checks'}->{$_} }
+ keys %{ $self->{'enabled-checks'} };
+}
+
=item $prof->is_overridable ($tag)
Returns a false value if the tag has been marked as
@@ -175,6 +192,57 @@ sub get_tag {
return $self->{'known-tags'}->{$tag};
}
+=item $prof->get_script ($script[, $known])
+
+Returns the Lintian::CheckScript for $script if it is enabled for the
+profile (or just a "known script" if $known is given and a truth value).
+Otherwise it returns undef.
+
+Note: A script is enabled as long as at least one of the tags it
+provides are enabled.
+
+=cut
+
+sub get_script {
+ my ($self, $script, $known) = @_;
+ return unless $known || $self->{'enabled-checks'}->{$script};
+ return $self->{'check-scripts'}->{$script};
+}
+
+=item $prof->enable_tags (@tags)
+
+Enables all tags named in @tags. Croaks if an unknown tag is found.
+
+=cut
+
+sub enable_tags {
+ my ($self, @tags) = @_;
+ for my $tag (@tags) {
+ my $ti = $self->{'known-tags'}->{$tag};
+ croak "Unknown tag $tag.\n" unless $ti;
+ next if exists $self->{'enabled-tags'}->{$tag};
+ $self->{'enabled-tags'}->{$tag} = 1;
+ $self->{'enabled-checks'}->{$ti->script}++;
+ }
+}
+
+=item $prof->disable_tags (@tags)
+
+Disable all tags named in @tags. Croaks if an unknown tag is found.
+
+=cut
+
+sub disable_tags {
+ my ($self, @tags) = @_;
+ for my $tag (@tags) {
+ my $ti = $self->{'known-tags'}->{$tag};
+ croak "Unknown tag $tag.\n" unless $ti;
+ next unless exists $self->{'enabled-tags'}->{$tag};
+ delete $self->{'enabled-tags'}->{$tag};
+ $self->{'enabled-checks'}->{$ti->script}--;
+ }
+}
+
=item Lintian::Profile->find_profile($pname, @dirs), $prof->find_profile($pname[, @dirs])
This can both be used as a static or as an instance method. If used
@@ -333,15 +401,12 @@ sub _read_profile_tags{
# these tags are enabled in the profile, otherwise they are disabled.
sub _enable_tags_from_field {
my ($self, $pname, $pheader, $field, $code, $enable) = @_;
- my $tags = $self->{'enabled-tags'};
+ my $method = \&enable_tags;
+ my @tags;
+ $method = \&disable_tags unless $enable;
return unless $pheader->{$field};
- foreach my $tag (map { $code->($field, $_) } $self->_split_comma_sep_field($pheader->{$field})){
- if($enable) {
- $tags->{$tag} = 1;
- } else {
- delete $tags->{$tag};
- }
- }
+ @tags = map { $code->($field, $_) } $self->_split_comma_sep_field($pheader->{$field});
+ $self->$method (@tags);
}
@@ -431,6 +496,7 @@ sub _load_check {
}
sub _load_checks {
+ # NB: testset/runtests uses this directly.
my ($self, $profile) = @_;
my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
opendir my $dirfd, "$root/checks" or croak "opendir $root/checks: $!";
diff --git a/lib/Lintian/Tags.pm b/lib/Lintian/Tags.pm
index c629884..b670339 100644
--- a/lib/Lintian/Tags.pm
+++ b/lib/Lintian/Tags.pm
@@ -24,7 +24,6 @@ use warnings;
use Lintian::Architecture qw(:all);
use Lintian::Output;
-use Lintian::Tag::Info;
use Lintian::Tag::Override;
use Util qw(fail);
@@ -248,14 +247,9 @@ sub tag {
}
# Retrieve the tag metadata and display the tag if the configuration
# says to display it.
- 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);
- }
+ # Note, we get the known as it will be suppressed by
+ # $self->suppressed below if the tag is not enabled.
+ my $info = $self->{profile}->get_tag ($tag, 1);
unless ($info) {
die "tried to issue unknown tag $tag";
}
@@ -749,14 +743,9 @@ configuration.
sub displayed {
my ($self, $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);
- }
+ # Note, we get the known as it will be suppressed by
+ # $self->suppressed below if the tag is not enabled.
+ my $info = $self->{profile}->get_tag ($tag, 1);
return 0 if ($info->experimental and not $self->{show_experimental});
my $only = $self->{only_issue};
if (%$only) {
diff --git a/t/scripts/profiles-coverage.t b/t/scripts/profiles-coverage.t
index 5d81c2c..ef0d789 100755
--- a/t/scripts/profiles-coverage.t
+++ b/t/scripts/profiles-coverage.t
@@ -9,7 +9,6 @@ use warnings;
use Test::More;
-use Lintian::Tag::Info;
use File::Find;
require Util; # Test::More (also) exports fail
diff --git a/testset/runtests b/testset/runtests
index af11e3c..a51d407 100755
--- a/testset/runtests
+++ b/testset/runtests
@@ -113,7 +113,7 @@ BEGIN {
my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Tag::Info;
+use Lintian::Profile;
use Util;
# --- Set the ways to call lintian and dpkg-buildpackage
@@ -135,21 +135,24 @@ $| = 1;
or fail("test directory $rundir does not exist\n");
$testok = 1;
-for my $desc_file (<$LINTIAN_ROOT/checks/*.desc>) {
- for my $i (read_dpkg_control($desc_file)) {
- $desc_file =~ s#.*/##;
- if (exists $i->{'tag'}) {
- my $experimental = $i->{'experimental'};
- 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;
- $tags{$i->{'tag'}}{'desc_type'} = $code;
- }
- }
+
+my $profile = Lintian::Profile->new ('debian/main', ["$ENV{'LINTIAN_ROOT'}/profiles"]);
+
+# force all checks to be loaded - not the best solution
+# - At the time of writing it is not needed for 'debian/main', but
+# that may change...
+$profile->_load_checks();
+
+for my $tag ($profile->tags (1)){
+ my $ti = $profile->get_tag ($tag, 1);
+ my $code = $ti->code;
+ $code = 'X' if $ti->experimental;
+ $tags{$tag}{'desc_file'} = $ti->script .'.desc';
+ $tags{$tag}{'desc_type'} = $code;
}
+undef $profile; # Don't need it any more.
+
if ($testok) {
print "done.\n";
} else {
--
Debian package checker
Reply to: