[SCM] Debian package checker branch, master, updated. 2.0.0-13-g0094324
The following commit has been merged in the master branch:
commit ff91d8b19631846fd4113d7f3058f21bbd87a98c
Author: Frank Lichtenheld <djpig@debian.org>
Date: Sat Sep 20 12:29:54 2008 +0200
Move tag output to Lintian::Output
Convert output format modules to subclasses of Lintian::Output.
Note: This commit breaks support for --color=html (which was undocumented
anyway and should be reimplemented as an own class) and changes the
behaviour of "--color=auto -i" (which could be fixed by not using
lintian-info for implementing -i anymore).
diff --git a/frontend/lintian b/frontend/lintian
index 8171ddc..628ae19 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -51,7 +51,7 @@ our $display_experimentaltags = 0; #flag for -E|--display-experimental switch
my $unpack_level = undef; #flag for -l|--unpack-level switch
our $no_override = 0; #flag for -o|--no-override switch
our $show_overrides = 0; #flag for --show-overrides switch
-our $color = 'never'; #flag for --color switch
+my $color = 'never'; #flag for --color switch
my $check_checksums = 0; #flag for -m|--md5sums|--checksums switch
my $allow_root = 0; #flag for --allow-root switch
my $fail_on_warnings = 0; #flag for --fail-on-warnings switch
@@ -644,11 +644,11 @@ if (defined $experimental_output_opts) {
foreach (keys %opts) {
if ($_ eq 'format') {
if ($opts{$_} eq 'colons') {
- require Tags::ColonSeparated;
- $Tags::output_formatter = \&Tags::ColonSeparated::print_tag;
+ require Lintian::Output::ColonSeparated;
+ $Lintian::Output::GLOBAL = new Lintian::Output::ColonSeparated;
} elsif ($opts{$_} eq 'letterqualifier') {
- require Tags::LetterQualifier;
- $Tags::output_formatter = \&Tags::LetterQualifier::print_tag;
+ require Lintian::Output::LetterQualifier;
+ $Lintian::Output::GLOBAL = new Lintian::Output::LetterQualifier;
}
}
no strict 'refs';
@@ -683,7 +683,6 @@ $Tags::show_experimental = $display_experimentaltags;
$Tags::show_overrides = $show_overrides;
%Tags::display_level = %display_level;
%Tags::display_source = %display_source;
-$Tags::color = $color;
%Tags::only_issue_tags = map { $_ => 1 } (split(/,/, $check_tags))
if defined $check_tags;
use warnings;
diff --git a/lib/Lintian/Output.pm b/lib/Lintian/Output.pm
index 32827c1..3fc41aa 100644
--- a/lib/Lintian/Output.pm
+++ b/lib/Lintian/Output.pm
@@ -113,8 +113,7 @@ sub print_tag {
$type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
my $tag;
- if ($self->color eq 'always'
- || ($self->color eq 'auto' && -t $self->stdout)) {
+ if ($self->_do_color) {
$tag .= Term::ANSIColor::colored($tag_info->{tag}, $tag_color);
} else {
$tag .= $tag_info->{tag};
@@ -123,6 +122,14 @@ sub print_tag {
$self->_print('', "$code: $pkg_info->{pkg}$type", "$tag$extra");
}
+sub _do_color {
+ my ($self) = @_;
+
+ return ($self->color eq 'always'
+ || ($self->color eq 'auto'
+ && -t $self->stdout));
+}
+
sub delimiter {
my ($self) = _global_or_object(@_);
diff --git a/lib/Tags/ColonSeparated.pm b/lib/Lintian/Output/ColonSeparated.pm
similarity index 51%
rename from lib/Tags/ColonSeparated.pm
rename to lib/Lintian/Output/ColonSeparated.pm
index 37ec076..ffbb5de 100644
--- a/lib/Tags/ColonSeparated.pm
+++ b/lib/Lintian/Output/ColonSeparated.pm
@@ -1,7 +1,7 @@
# 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>
+# Copyright (C) 2005,2008 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
@@ -19,11 +19,66 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
-package Tags::ColonSeparated;
+package Lintian::Output::ColonSeparated;
use strict;
use warnings;
-sub quote_char {
+use Lintian::Output qw(:util);
+use base qw(Lintian::Output);
+
+sub print_tag {
+ my ( $self, $pkg_info, $tag_info, $information ) = _global_or_object(@_);
+
+ my $extra = "@$information";
+
+ $self->_print(
+ 'tag',
+ $tag_info->{type},
+ $tag_info->{severity},
+ $tag_info->{certainty},
+ (exists($tag_info->{experimental}) ? 'X' : '').
+ ($tag_info->{overridden}{override} ? 'O' : ''),
+ @{$pkg_info}{'pkg','version','arch','type'},
+ $tag_info->{tag},
+ $extra,
+ $tag_info->{overridden}{override},
+ );
+}
+
+sub _delimiter {
+ return;
+}
+
+sub _message {
+ my ($self, @args) = @_;
+
+ foreach (@args) {
+ $self->_print('message', $_);
+ }
+}
+
+sub _warning {
+ my ($self, @args) = @_;
+
+ foreach (@args) {
+ $self->_print('warning', $_);
+ }
+}
+
+sub _print {
+ my ($self, @args) = @_;
+
+ my $output = $self->string(@args);
+ print {$self->stdout} $output;
+}
+
+sub string {
+ my ($self, @args) = _global_or_object(@_);
+
+ return join(':', _quote_char( ':', @args))."\n";
+}
+
+sub _quote_char {
my ( $char, @items ) = @_;
foreach (@items) {
@@ -34,23 +89,5 @@ sub quote_char {
return @items;
}
-sub print_tag {
- my ( $pkg_info, $tag_info, $information ) = @_;
-
- my $extra = "@$information";
-
- print join(':', quote_char( ':',
- $tag_info->{type},
- $tag_info->{severity},
- $tag_info->{certainty},
- (exists($tag_info->{experimental}) ? 'X' : '').
- ($tag_info->{overridden}{override} ? 'O' : ''),
- @{$pkg_info}{'pkg','version','arch','type'},
- $tag_info->{tag},
- $extra,
- $tag_info->{overridden}{override},
- ))."\n";
-}
-
1;
diff --git a/lib/Tags/LetterQualifier.pm b/lib/Lintian/Output/LetterQualifier.pm
similarity index 83%
rename from lib/Tags/LetterQualifier.pm
rename to lib/Lintian/Output/LetterQualifier.pm
index 874ffcb..20aa9c8 100644
--- a/lib/Tags/LetterQualifier.pm
+++ b/lib/Lintian/Output/LetterQualifier.pm
@@ -16,13 +16,16 @@
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.
-package Tags::LetterQualifier;
+package Lintian::Output::LetterQualifier;
use strict;
use warnings;
-use Term::ANSIColor;
-use Tags;
+use Term::ANSIColor qw(colored);
+use Tags ();
+
+use Lintian::Output qw(:util);
+use base qw(Lintian::Output);
my %codes = (
'wishlist' => {
@@ -52,7 +55,7 @@ my %codes = (
},
);
-my %colors = (
+my %lq_default_colors = (
'wishlist' => {
'wild-guess' => 'green',
'possible' => 'green',
@@ -80,8 +83,17 @@ my %colors = (
},
);
+sub new {
+ my $self = Lintian::Output::new('Lintian::Output::LetterQualifier');
+
+ $self->colors({%lq_default_colors});
+
+ return $self;
+}
+
+
sub print_tag {
- my ( $pkg_info, $tag_info, $information ) = @_;
+ my ( $self, $pkg_info, $tag_info, $information ) = @_;
my $code = Tags::get_tag_code($tag_info);
$code = 'X' if exists $tag_info->{experimental};
@@ -99,13 +111,13 @@ sub print_tag {
my $extra = @$information ? " @$information" : '';
$extra = '' if $extra eq ' ';
- if ($Tags::color eq 'always' || ($Tags::color eq 'auto' && -t STDOUT)) {
- my $color = $colors{$sev}{$cer};
+ if ($self->_do_color) {
+ my $color = $self->colors->{$sev}{$cer};
$lq = colored($lq, $color);
$tag = colored($tag, $color);
}
- print "$code\[$lq\]: $pkg$type: $tag$extra\n";
+ $self->_print('', "$code\[$lq\]: $pkg$type", "$tag$extra");
}
1;
diff --git a/lib/Tags.pm b/lib/Tags.pm
index db9a402..e3b5379 100644
--- a/lib/Tags.pm
+++ b/lib/Tags.pm
@@ -28,20 +28,11 @@ use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(tag);
-# support for ANSI color output via colored()
-use Term::ANSIColor;
-
-# Quiet "Name "main::LINTIAN_ROOT" used only once"
-# The variables comes from 'lintian'
-() = ($main::verbose, $main::debug);
+use Lintian::Output;
# configuration variables and defaults
-our $verbose = $::verbose;
-our $debug = $::debug;
our $show_experimental = 0;
our $show_overrides = 0;
-our $output_formatter = \&print_tag;
-our $color = 'never';
our %display_level;
our %display_source;
our %only_issue_tags;
@@ -87,8 +78,6 @@ my %codes = (
'serious' => { 'wild-guess' => 'E', 'possible' => 'E', 'certain' => 'E' },
);
-my %colors = ( 'E' => 'red' , 'W' => 'yellow' , 'I' => 'cyan' );
-
my %type_to_sev = (
'error' => 'important',
'warning' => 'normal',
@@ -276,38 +265,6 @@ sub get_stats {
return \%stats;
}
-# Color tags with HTML. Takes the tag and the color name.
-sub colored_html {
- my ($tag, $color) = @_;
- return qq(<span style="color: $color">$tag</span>);
-}
-
-sub print_tag {
- my ( $pkg_info, $tag_info, $information ) = @_;
-
- my $extra = '';
- $extra = " @$information" if @$information;
- $extra = '' if $extra eq ' ';
- my $code = get_tag_code($tag_info);
- my $tag_color = $colors{$code};
- $code = 'X' if exists $tag_info->{experimental};
- $code = 'O' if $tag_info->{overridden}{override};
- my $type = '';
- $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
-
- my $output = "$code: $pkg_info->{pkg}$type: ";
- if ($color eq 'always' || ($color eq 'auto' && -t STDOUT)) {
- $output .= colored($tag_info->{tag}, $tag_color);
- } elsif ($color eq 'html') {
- $output .= colored_html($tag_info->{tag}, $tag_color);
- } else {
- $output .= $tag_info->{tag};
- }
- $output .= "$extra\n";
-
- print $output;
-}
-
# Extract manual sources from a given tag. Returns a hash that has manual
# names as keys and sections/ids has values.
sub get_tag_source {
@@ -378,7 +335,8 @@ sub tag {
return 1 if skip_print( $tag_info );
- &$output_formatter( $info{$current}, $tag_info, \@information );
+ $Lintian::Output::GLOBAL->print_tag( $info{$current}, $tag_info,
+ \@information );
return 1;
}
--
Debian package checker
Reply to: