lintian: r493 - in trunk/lib: . Tags

[djpig@debian.org]

Author: djpig
Date: 2005-09-21 22:03:06 +0200 (Wed, 21 Sep 2005)
New Revision: 493

Added:
   trunk/lib/Tags/
   trunk/lib/Tags/ColonSeparated.pm
Modified:
   trunk/lib/Tags.pm
Log:
Add support for two new output formats and fix some minor bugs


Added: trunk/lib/Tags/ColonSeparated.pm
===================================================================
--- trunk/lib/Tags/ColonSeparated.pm	2005-09-21 19:59:03 UTC (rev 492)
+++ trunk/lib/Tags/ColonSeparated.pm	2005-09-21 20:03:06 UTC (rev 493)
@@ -0,0 +1,55 @@
+# Tags::ColonSeparated -- Perl tags functions for lintian
+# $Id: Tags.pm 489 2005-09-17 00:06:30Z djpig $
+
+# Copyright (C) 2005 Frank Lichtenheld <frank@lichtenheld.de>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Tags::ColonSeparated;
+use strict;
+use warnings;
+
+sub quote_char {
+    my ( $char, @items ) = @_;
+
+    foreach (@items) {
+	s/\\/\\\\/go;
+	s/\Q$char\E/\\$char/go;
+    }
+
+    return @items;
+}
+
+sub print_tag {
+    my ( $pkg_info, $tag_info, $information ) = @_;
+
+    my $extra = "@$information";
+
+    print join(':', quote_char( ':',
+				$tag_info->{severity},
+				$tag_info->{significance},
+				@{$tag_info->{overridden}}{'override',
+							   'severity',
+							   'significance'},
+				@{$pkg_info}{'pkg','version','arch','type'},
+				$tag_info->{tag},
+				$extra,
+				))."\n";
+}
+
+1;
+

Modified: trunk/lib/Tags.pm
===================================================================
--- trunk/lib/Tags.pm	2005-09-21 19:59:03 UTC (rev 492)
+++ trunk/lib/Tags.pm	2005-09-21 20:03:06 UTC (rev 493)
@@ -22,6 +22,7 @@
 
 package Tags;
 use strict;
+use warnings;
 
 use Exporter;
 our @ISA = qw(Exporter);
@@ -32,7 +33,7 @@
 our $debug = $::debug;
 our $show_info = 0;
 our $show_overrides = 0;
-our $output_format = 'default';
+our $output_formatter = \&print_tag;
 our $min_severity = 1;
 our $max_severity = 99;
 our $min_significance = 1;
@@ -69,21 +70,24 @@
 
 # Compatibility stuff
 my %codes = ( 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' );
-my %type_to_sev = ( error => 3, warning => 1, info => 0 );
-my @sev_to_type = qw( info warning error error );
+our %type_to_sev = ( error => 4, warning => 2, info => 0 );
+our @sev_to_type = qw( info warning warning error error );
 
+my @sig_to_qualifier = ( '??', '?', '', '!' );
+my @sev_to_code = qw( I W W E E );
+
 # Add a new tag, supplied as a hash reference
 sub add_tag {
 	my $newtag = shift;
-	if (exists $tags{$newtag->{'tag'}}) {
-	    warn "Duplicate tag: $newtag->{'tag'}\n";
+	if (exists $tags{$newtag->{tag}}) {
+	    warn "Duplicate tag: $newtag->{tag}\n";
 	    return 0;
 	}
 
 	# smooth transition
 	$newtag->{type} = $sev_to_type[$newtag->{severity}]
 	    unless $newtag->{type};
-	$newtag->{significance} = 3 unless exists $newtag->{significance};
+	$newtag->{significance} = 2 unless exists $newtag->{significance};
 	$newtag->{severity} = $type_to_sev{$newtag->{type}}
 	    unless exists $newtag->{severity};
 	$tags{$newtag->{'tag'}} = $newtag;
@@ -190,9 +194,9 @@
     my $extra = '';
     $extra = " @$information" if @$information;
     $extra = '' if $extra eq ' ';
-    return $info{$current}{overrides}{$tag_info->{tag}}
+    return $tag_info->{tag}
         if exists $info{$current}{overrides}{$tag_info->{tag}};
-    return $info{$current}{overrides}{"$tag_info->{tag}$extra"}
+    return "$tag_info->{tag}$extra"
         if exists $info{$current}{overrides}{"$tag_info->{tag}$extra"};
 
     return '';
@@ -235,12 +239,6 @@
 sub print_tag {
     my ( $pkg_info, $tag_info, $information ) = @_;
 
-    return if 
-	$tag_info->{overridden}{severity} != 0
-	|| $tag_info->{overridden}{significance} != 0
-	|| ( $tag_info->{overridden}{override} &&
-	     !$show_overrides);
-
     my $extra = '';
     $extra = " @$information" if @$information;
     $extra = '' if $extra eq ' ';
@@ -252,6 +250,23 @@
     print "$code: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
 }
 
+sub print_tag_new {
+    my ( $pkg_info, $tag_info, $information ) = @_;
+
+    my $extra = '';
+    $extra = " @$information" if @$information;
+    $extra = '' if $extra eq ' ';
+    my $code = $sev_to_code[$tag_info->{severity}];
+    $code = 'O' if $tag_info->{overridden}{override};
+    my $qualifier = $sig_to_qualifier[$tag_info->{significance}];
+    $qualifier = '' if $code eq 'O';
+    my $type = '';
+    $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
+
+    print "$code$qualifier: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
+
+}
+
 sub tag {
     my ( $tag, @information ) = @_;
     unless ($current) {
@@ -268,7 +283,13 @@
 
     record_stats( $tag_info );
 
-    print_tag( $info{$current}, $tag_info, \@information );
+    return 1 if
+	$tag_info->{overridden}{severity} != 0
+	|| $tag_info->{overridden}{significance} != 0
+	|| ( $tag_info->{overridden}{override} &&
+	     !$show_overrides);
+
+    &$output_formatter( $info{$current}, $tag_info, \@information );
     return 1;
 }