[SCM] Debian package checker branch, master, updated. 1.24.4-57-gcfdcbc8

["Jordà Polo" <jorda@ettin.org>]

The following commit has been merged in the master branch:
commit fe910125365fc158b8e4661e1047bfdb809affe6
Author: Jordà Polo <jorda@ettin.org>
Date:   Wed Aug 13 17:40:16 2008 +0200

    Avoid duplication of Severity/Certainty code
    
    Severities and Certainties are now defined as a simple (sorted) list and
    levels are generated automatically. A new subroutine to get the E|W|I of a
    given tag, get_tag_code(), is also available.
    
    The `transtats' script now uses the functionallity available in the Tags
    package.

diff --git a/lib/Tags.pm b/lib/Tags.pm
index 5640046..6676252 100644
--- a/lib/Tags.pm
+++ b/lib/Tags.pm
@@ -76,20 +76,16 @@ my %info;
 # Currently selected file (not package!)
 my $current;
 
-my %severity_level = (
-    'serious' => 4,
-    'important' => 3,
-    'normal' => 2,
-    'minor' => 1,
-    'wishlist' => 0
-);
+# Possible Severity: and Certainty: values, sorted from lowest to highest.
+our @severity_list = qw(wishlist minor normal important serious);
+our @certainty_list = qw(wild-guess possible certain);
 
-my %certainty_level = (
-    'certain' => 2,
-    'possible' => 1,
-    'wild-guess' => 0
-);
+my %severity_level;
+@severity_level{@severity_list} = (0 .. $#severity_list);
+my %certainty_level;
+@certainty_level{@certainty_list} = (0 .. $#certainty_list);
 
+# Map Severity/Certainty levels to E|W|I codes.
 my @codes = (
     [ 'I', 'I', 'I' ], # wishlist (wild-guess, possible, certain)
     [ 'I', 'I', 'W' ], # minor
@@ -218,6 +214,20 @@ sub get_tag_info {
     return undef;
 }
 
+# Returns the E|W|I code for a given tag.
+sub get_tag_code {
+    my ( $tag_info ) = @_;
+    return get_tag_value($tag_info, \@codes);
+}
+
+# Returns the value in a Severity/Certainty mapping for a given tag.
+sub get_tag_value {
+    my ( $tag_info, $map ) = @_;
+    my $sev = $tag_info->{severity};
+    my $cer = $tag_info->{certainty};
+    return $map->[$severity_level{$sev}][$certainty_level{$cer}];
+}
+
 # check if a certain tag has a override for the 'current' package
 sub check_overrides {
     my ( $tag_info, $information ) = @_;
@@ -272,13 +282,11 @@ sub colored_html {
 
 sub print_tag {
     my ( $pkg_info, $tag_info, $information ) = @_;
-    my $sev = $tag_info->{severity};
-    my $cer = $tag_info->{certainty};
 
     my $extra = '';
     $extra = " @$information" if @$information;
     $extra = '' if $extra eq ' ';
-    my $code = $codes[$severity_level{$sev}][$certainty_level{$cer}];
+    my $code = get_tag_code($tag_info);
     $code = 'X' if exists $tag_info->{experimental};
     $code = 'O' if $tag_info->{overridden}{override};
     my $type = '';
diff --git a/private/transtats b/private/transtats
index 056cadf..f911483 100755
--- a/private/transtats
+++ b/private/transtats
@@ -13,28 +13,17 @@ use strict;
 use warnings;
 
 my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
-unshift @INC, "$LINTIAN_ROOT/lib";
 
-require Read_pkglists;
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Read_pkglists;
+use Tags;
 
-my @severities = qw(wishlist minor normal important serious);
-my @certainties = qw(wild-guess possible certain);
+my @severities = @Tags::severity_list;
+my @certainties = @Tags::certainty_list;
 my @types = qw(info warning error);
 my @codes = qw(I W E);
 
-my %severity_index;
-@severity_index{@severities} = (0 .. $#severities);
-my %certainty_index;
-@certainty_index{@certainties} = (0 .. $#certainties);
-
 my %old_codes = ( info => 'I', warning => 'W', error => 'E' );
-my @new_codes = (
-    [ 'I', 'I', 'I' ],
-    [ 'I', 'I', 'W' ],
-    [ 'I', 'W', 'W' ],
-    [ 'W', 'E', 'E' ],
-    [ 'E', 'E', 'E' ],
-);
 
 my %stats;
 my $num_tags = 0;
@@ -74,10 +63,8 @@ for my $check (readdir CHECKDIR) {
 
         next if not $done;
 
-        my $sev = $severity_index{$severity};
-        my $cer = $certainty_index{$certainty};
         my $old_code = $old_codes{$type};
-        my $new_code = $new_codes[$sev][$cer];
+        my $new_code = Tags::get_tag_code($tag);
         push(@{$stats{code}{$old_code}{$new_code}}, $name);
 
         $num_ok++ if $old_code eq $new_code;

-- 
Debian package checker