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 <[EMAIL PROTECTED]> +# +# 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, [EMAIL PROTECTED] ); + 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, [EMAIL PROTECTED] ); return 1; } -- To UNSUBSCRIBE, email to [EMAIL PROTECTED] with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
