[SCM] Debian package checker branch, vendor-profile, updated. 2.5.1-20-ge97478f

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the vendor-profile branch:
commit e97478fbf2e9c64c69e5a82bbfd9705d76b84231
Author: Niels Thykier <niels@thykier.net>
Date:   Tue Jun 21 00:32:57 2011 +0200

    Allow profiles to change the severity of tags

diff --git a/frontend/lintian b/frontend/lintian
index b4fa0b2..f7b674c 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -675,6 +675,7 @@ require Lintian::Command;
 import Lintian::Command qw(spawn reap);
 require Lintian::ProcessablePool;
 require Lintian::Profile;
+require Lintian::Tag::Info;
 require Lintian::Tags;
 import Lintian::Tags qw(tag);
 
@@ -744,9 +745,14 @@ if ($LINTIAN_PROFILE) {
 					[PROFILE_PATH, "$LINTIAN_ROOT/profiles"]);
     my @ptags = $profile->tags;
     my @ign_overrides = $profile->ignored_overrides;
+    my $severities = $profile->severity_changes;
     v_msg('Using profile ' . $profile->name . '.');
     $TAGS->only(@ptags) if @ptags;
     $TAGS->ignore_overrides(@ign_overrides) if @ign_overrides;
+    while ( my ($tagname, $severity) = each(%$severities) ){
+	my $tag = Lintian::Tag::Info->new($tagname);
+	$tag->set_severity($severity);
+    }
     # Initialize display level settings.
     for my $level (@display_level) {
 	eval { $TAGS->display(@$level) };
diff --git a/lib/Lintian/Profile.pm b/lib/Lintian/Profile.pm
index 363885d..254980d 100644
--- a/lib/Lintian/Profile.pm
+++ b/lib/Lintian/Profile.pm
@@ -30,6 +30,15 @@ use Util;
 my %TAG_MAP = ();
 # maps check name to list of tag names.
 my %CHECK_MAP = ();
+my %SEVERITIES = (
+    'pedantic'  => 1,
+    'wishlist'  => 1,
+    'minor'     => 1,
+    'normal'    => 1,
+    'important' => 1,
+    'serious'   => 1,
+    );
+
 
 sub _load_checks {
     my $root = $ENV{LINTIAN_ROOT} || '/usr/share/lintian';
@@ -64,7 +73,8 @@ sub new {
         'parents'           => [],
         'profile-path'      => $ppath,
         'enabled-tags'      => {},
-	'ignored-overrides' => {},
+        'ignored-overrides' => {},
+        'severity-changes'  => {},
     };
     $self = bless $self, $type;
     $profile = $self->find_profile($name);
@@ -81,6 +91,11 @@ sub tags {
     return keys %{ $self->{'enabled-tags'} };
 }
 
+sub severity_changes {
+    my ($self) = @_;
+    return $self->{'severity-changes'};
+}
+
 sub ignored_overrides {
     my ($self) = @_;
     return keys %{ $self->{'ignored-overrides'} };
@@ -129,7 +144,7 @@ sub _read_profile {
         $parentf = $self->find_profile($parent);
         fail "Cannot find $parent, which $pname extends.\n"
             unless $parentf;
-        $self->read_profile($parentf);
+        $self->_read_profile($parentf);
         push @$plist, $parent;
     }
     $self->_read_profile_tags($pname, $pheader);
@@ -144,16 +159,23 @@ sub _read_profile {
 sub _read_profile_section {
     my ($self, $pname, $section, $sno) = @_;
     my @tags = $self->_split_comma_sep_field($section->{'tag'});
-    my $overridable = $self->_parse_boolean($section->{'overridable'}, 0, $pname, $sno);
+    my $overridable = $self->_parse_boolean($section->{'overridable'}, -1, $pname, $sno);
+    my $severity = $section->{'severity'}//'';
     my $ignore_map = $self->{'ignored-overrides'};
+    my $sev_map = $self->{'severity-changes'};
     fail "Profile \"$pname\" is missing Tag field (or it is empty) in section $sno." unless @tags;
+    fail "Profile \"$pname\" contains invalid severity \"$severity\" in section $sno."
+        if $severity && !$SEVERITIES{$severity};
     foreach my $tag (@tags) {
 	fail "Unknown check $tag in $pname (section $sno)\n" unless exists $TAG_MAP{$tag};
-	if ($overridable) {
-	    delete $ignore_map->{$tag};
-	} else {
-	    $ignore_map->{$tag} = 1;
-	}
+        $sev_map->{$tag} = $severity if $severity;
+        if ( $overridable < 0 ) {
+            if ($overridable) {
+                delete $ignore_map->{$tag};
+            } else {
+                $ignore_map->{$tag} = 1;
+            }
+        }
     }
 }
 
diff --git a/lib/Lintian/Tag/Info.pm b/lib/Lintian/Tag/Info.pm
index 405e75c..c8a0a65 100644
--- a/lib/Lintian/Tag/Info.pm
+++ b/lib/Lintian/Tag/Info.pm
@@ -106,6 +106,7 @@ sub _load_tag_data {
             $tag->{info} = '' unless exists($tag->{info});
             $tag->{script} = $header->{'check-script'};
             $tag->{'script-type'} = $header->{'type'};
+            $tag->{'effective-severity'} = $tag->{severity};
             $INFO{$tag->{tag}} = $tag;
         }
     }
@@ -156,7 +157,7 @@ separately.
 
 sub code {
     my ($self) = @_;
-    return $CODES{$self->{severity}}{$self->{certainty}};
+    return $CODES{$self->{'effective-severity'}}{$self->{certainty}};
 }
 
 =item description([FORMAT [, INDENT]])
@@ -315,17 +316,33 @@ sub experimental {
     return ($self->{experimental} and $self->{experimental} eq 'yes');
 }
 
-=item severity()
+=item severity([$real])
 
-Returns the severity of the tag.
+Returns the severity of the tag; if $real is a truth value
+the real (original) severity is returned, otherwise the
+effective severity is returned.
+
+See set_severity()
 
 =cut
 
 sub severity {
-    my ($self) = @_;
+    my ($self, $real) = @_;
+    return $self->{'effective-severity'} unless $real;
     return $self->{severity};
 }
 
+=item set_severity($severity)
+
+Modifies the effective severity of the tag.
+
+=cut
+
+sub set_severity{
+    my ($self, $sev) = @_;
+    $self->{'effective-severity'} = $sev;
+}
+
 =item script()
 
 Returns the check script corresponding to this tag.

-- 
Debian package checker