#! /bin/sh /usr/share/dpatch/dpatch-run
## 500-backport-1.23.22-frontend.dpatch by Eero Häkkinen <eero.hakkinen@nokia.com>
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Backported frontends from lintian 1.23.22

@DPATCH@
diff -urNad lintian-1.23.8/frontend/lintian lintian-1.23.22/frontend/lintian
--- lintian-1.23.8/frontend/lintian	2005-01-02 00:29:42.000000000 +0000
+++ lintian-1.23.22/frontend/lintian	2006-07-19 11:57:17.000000000 +0000
@@ -17,8 +17,8 @@
 # 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., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
 # }}}
 
 # {{{ libraries and such
@@ -64,6 +64,8 @@
 my $LINTIAN_CFG = "";		#config file to use
 our $LINTIAN_ROOT;		#location of the lintian modules
 
+my $experimental_output_opts = undef;
+
 my @packages;
 
 my $action;
@@ -72,7 +74,7 @@
 my $unpack_info;
 my $cwd;
 my $cleanup_filename;
-my $exit_code;
+my $exit_code = 0;
 my $LAB;
 
 my %collection_info;
@@ -258,6 +260,9 @@
 	       "unpack-info|U=s" => \&record_unpack_info,
 	       "md5sums|m" => \$check_md5sums,
 	       "allow-root" => \$allow_root,
+	       # Note: Ubuntu has (and other derivatives might gain) a
+	       # -D/--debian option to make lintian behave like in Debian, that
+	       # is, to revert distribution-specific changes
 
 	       # ------------------ configuration options
 	       "cfg=s" => \$LINTIAN_CFG,
@@ -274,6 +279,9 @@
 	       "source|s" => \&record_pkgmode,
 	       "udeb" => \&record_pkgmode,
 	       "packages-file|p=s" => \$packages_file,
+
+	       # ------------------ experimental
+	       "exp-output:s" => \$experimental_output_opts,
 	      );
 
 # init commandline parser
@@ -385,7 +393,7 @@
 # LINTIAN_ARCH must have a value.
 unless (defined $LINTIAN_ARCH) {
     if ($LINTIAN_DIST) {
-	chop($LINTIAN_ARCH=`dpkg --print-installation-architecture`);
+	chop($LINTIAN_ARCH=`dpkg --print-architecture`);
     } else {
 	$LINTIAN_ARCH = 'any';
     }
@@ -475,7 +483,14 @@
 import Util;
 import Pipeline;
 
-# }}} 
+require Tags;
+import Tags;
+
+my @l_secs = read_dpkg_control("$LINTIAN_ROOT/checks/lintian.desc");
+shift(@l_secs);
+map Tags::add_tag($_), @l_secs;
+
+# }}}
 
 # {{{ No clue why this code is here...
 
@@ -607,6 +622,7 @@
 		next;
 	    }
 
+	    Tags::set_pkg( $arg, $arg_name, "", "", 'binary' );
 	    # check distribution field
 	    if (! (($data->{'distribution'} eq 'stable')
 		  or ($data->{'distribution'} eq 'testing')
@@ -616,7 +632,8 @@
 		  or ($data->{'distribution'} =~ /\w+-security/))
                ) {
 		# bad distribution entry
-		print "E: $arg_name: bad-distribution-in-changes-file $data->{'distribution'}\n";
+		tag("bad-distribution-in-changes-file",
+		    $data->{'distribution'});
 	    }
 
 	    # process all listed `files:'
@@ -636,7 +653,7 @@
 		if (-s $filename ne $size) {
 		    print "N: size is $size, argname is $arg_name, filename is $filename\n";
 
-		    print "E: $arg_name: file-size-mismatch-in-changes-file $file\n";
+		    tag( "file-size-mismatch-in-changes-file", $file );
 		}
 	
 		# check md5sums
@@ -644,13 +661,13 @@
 		    my $real_md5sum = get_file_md5($filename);
 
 		    if ($real_md5sum ne $md5sum) {
-			print "E: $arg_name: md5sum-mismatch-in-changes-file $file\n";
+			tag( "md5sum-mismatch-in-changes-file", $file );
 		    }
 		}
 	
 		# check section
 		if (($section eq 'non-free') or ($section eq 'contrib')) {
-		    print "E: $arg_name: bad-section-in-changes-file $file $section\n";
+		    tag( "bad-section-in-changes-file", $file, $section );
 		}
 	
 		# process file?
@@ -668,6 +685,14 @@
 				     $info->{'version'}, $filename);
 		}
 	    }
+
+	    unless ($exit_code) {
+		my $stats = Tags::get_stats( $arg );
+		if ($stats->{severity}{4}) {
+		    $exit_code = 1;
+		}
+	    }
+
 	} else {
 	    fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
 	}
@@ -850,10 +875,22 @@
 
 # {{{ Now we're ready to load info about checks & tags
 
-require Tags;
-import Tags;
+no warnings 'once';
+if (defined $experimental_output_opts) {
+    $Tags::output_formatter = \&Tags::print_tag_new;
+    my %opts = map { split(/=/) } split( /,/, $experimental_output_opts );
+    foreach (keys %opts) {
+	if ($_ eq 'format') {
+	    if ($opts{$_} eq 'colons') {
+		require Tags::ColonSeparated;
+		$Tags::output_formatter = \&Tags::ColonSeparated::print_tag;
+	    }
+	}
+	no strict 'refs';
+	${"Tags::$_"} = $opts{$_};
+    }
+}
 
-no warnings;
 $Tags::show_info = $display_infotags;
 $Tags::show_overrides = $show_overrides;
 use warnings;
@@ -920,10 +957,10 @@
 	    }
 	}
 
+	shift(@secs);
+	map Tags::add_tag($_), @secs;
     } # end: if ne lintian
 
-    shift(@secs);
-    map Tags::add_tag($_), @secs;
 }
 
 closedir(CHECKDIR);
@@ -1056,8 +1093,6 @@
     printf "N: Selected checks: %s\n",join(',',keys %checks);
 }
 
-$exit_code = 0;
-
 require Checker;
 
 # for each package (the `reverse sort' is to make sure that source packages are
@@ -1203,7 +1238,7 @@
     }
 
     if ($action eq 'check') { 	# read override file
-	Tags::pkg_reset($long_type eq 'binary' ? $pkg : "$pkg $long_type");
+	Tags::set_pkg( $file, $pkg, "", "", $long_type );
 
 
 	unless ($no_override) 
@@ -1259,21 +1294,25 @@
 		print "N: Skipping $action of $long_type package $pkg\n";
 		next PACKAGE;
 	    }
+
+	}
+	unless ($exit_code) {
+	    my $stats = Tags::get_stats( $file );
+	    if ($stats->{severity}{4}) {
+		$exit_code = 1;
+	    }
 	}
 
 	# report unused overrides
-#	if (not $no_override and $verbose) {
-#	    my $ppkg = $type eq 'b' ? quotemeta($pkg) : quotemeta("$pkg $long_type");
-#	    for my $o (sort keys %overridden) {
-#		next unless $o =~ /^$ppkg:/;
-#		next if $overridden{$o};
-#
-#		print "I: $pkg: unused-override $o\n";
-#
-#		# mark override entry as used
-#		$overridden{$o} = 99999;
-#	    }
-#	}
+	if (not $no_override and $verbose) {
+	    my $overrides = Tags::get_overrides( $file );
+
+	    for my $o (sort keys %$overrides) {
+		next if $overrides->{$o};
+
+		tag( "unused-override", $o );
+	    }
+	}
     }
 
     # chdir to lintian root directory (to unlock $base so it can be removed below)
diff -urNad lintian-1.23.8/frontend/lintian-info lintian-1.23.22/frontend/lintian-info
--- lintian-1.23.8/frontend/lintian-info	2004-11-24 22:44:09.000000000 +0000
+++ lintian-1.23.22/frontend/lintian-info	2006-07-19 11:57:17.000000000 +0000
@@ -17,8 +17,8 @@
 # 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., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
 
 use strict;
 
@@ -48,6 +48,7 @@
     my ($type, $pkg, @pieces) = split(/:\s+/);
     if ($type =~ m/^[OEWIX]$/) {
 	$tag = shift @pieces;
+	next if not defined $tag;
 	($tag) = split(/\s+/, $tag, 2);
 
 	next if not exists $tag_info{$tag} or $already_displayed{$tag}++;
diff -urNad lintian-1.23.8/lib/Tags/ColonSeparated.pm lintian-1.23.22/lib/Tags/ColonSeparated.pm
--- lintian-1.23.8/lib/Tags/ColonSeparated.pm	1970-01-01 00:00:00.000000000 +0000
+++ lintian-1.23.22/lib/Tags/ColonSeparated.pm	2006-07-19 11:58:28.000000000 +0000
@@ -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;
+
diff -urNad lintian-1.23.8/lib/Tags.pm lintian-1.23.22/lib/Tags.pm
--- lintian-1.23.8/lib/Tags.pm	2006-07-18 13:39:52.000000000 +0000
+++ lintian-1.23.22/lib/Tags.pm	2006-07-19 11:57:40.000000000 +0000
@@ -1,7 +1,8 @@
 # Tags -- Perl tags functions for lintian
-# $Id: Tags.pm 364 2004-11-13 21:07:48Z djpig $
+# $Id: Tags.pm 510 2005-10-14 00:19:49Z djpig $
 
 # Copyright (C) 1998-2004 Various authors
+# 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
@@ -16,30 +17,30 @@
 # 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., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
 
 package Tags;
 use strict;
-
-use Util;
+use warnings;
 
 use Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(tag);
 
-my $LINTIAN_ROOT = $::LINTIAN_ROOT;
-
-# Can also be more precise later on (only verbose with lab actions) but for
-# now this will do --Jeroen
-my $verbose = $::verbose;
-my $debug = $::debug;
-
-# What to print between the "E:" and the tag, f.e. "package source"
-our $prefix = undef;
+# configuration variables and defaults
+our $verbose = $::verbose;
+our $debug = $::debug;
 our $show_info = 0;
+our $show_overrides = 0;
+our $output_formatter = \&print_tag;
+our $min_severity = 1;
+our $max_severity = 99;
+our $min_significance = 1;
+our $max_significance = 99;
 
-# The master hash with all tag info. Key is a hash too, with these stuff:
+# The master hash with all tag info. Key is the tag name, value another hash
+# with the following keys:
 # - tag: short name
 # - type: error/warning/info/experimental
 # - info: Description in HTML
@@ -47,53 +48,265 @@
 # - experimental: experimental status (possibly undef)
 my %tags;
 
-our $show_overrides;
-# in the form overrides->tag or full thing
-my %overrides;
+# Statistics per file. Key is the filename, value another hash with the
+# following keys:
+# - overrides
+# - tags
+# - severity
+# - significance
+my %stats;
 
-my $codes = { 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' };
+# Info about a specific file. Key is the the filename, value another hash
+# with the following keys:
+# - pkg: package name
+# - version: package version
+# - arch: package architecture
+# - type: one of 'binary', 'udeb' or 'source'
+# - overrides: hash with all overrides for this file as keys
+my %info;
 
+# Currently selected file (not package!)
+my $current;
 
-# TODO
-# - override support back in --> just the unused reporting
-# - be able to return whether any errors were there, better, full stats
+# Compatibility stuff
+my %codes = ( 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' );
+our %type_to_sev = ( error => 4, warning => 2, info => 0 );
+our @sev_to_type = qw( info warning warning error error );
 
-# Call this function to add a certain tag, by supplying the info as a hash
+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;
-	fail("Duplicate tag: $newtag->{'tag'}")
-		if exists $tags{$newtag->{'tag'}};
-	
+	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} = 2 unless exists $newtag->{significance};
+	$newtag->{severity} = $type_to_sev{$newtag->{type}}
+	    unless exists $newtag->{severity};
 	$tags{$newtag->{'tag'}} = $newtag;
+	return 1;
 }
 
-# Used to reset the matched tags data
-sub pkg_reset {
-	$prefix = shift;
-	%overrides = ();
+# Add another file, will fail if there is already stored info about
+# the file
+sub set_pkg {
+    my ( $file, $pkg, $version, $arch, $type ) = @_;
+
+    if (exists $info{$file}) {
+	warn "File $file was already processed earlier\n";
+	return 0;
+    }
+
+    $current = $file;
+    $info{$file} = {
+	pkg => $pkg,
+	version => $version,
+	arch => $arch,
+	type => $type,
+	overrides => {},
+    };
+    $stats{$file} = {
+	severity => {},
+	significance => {},
+	tags => {},
+	overrides => {},
+    };
+
+    return 1;
 }
 
-# Add an override, string tag, string rest
+# select another file as 'current' without deleting or adding any information
+# the file must have been added with add_pkg
+sub select_pkg {
+    my ( $file ) = @_;
+
+    unless (exists $info{$file}) {
+	warn "Can't select package $file";
+	return 0;
+    }
+
+    $current = $file;
+    return 1;
+}
+
+# only delete the value of 'current' without deleting any stored information
+sub reset_pkg {
+    undef $current;
+    return 1;
+}
+
+# delete all the stored information (including tags)
+sub reset {
+    undef %stats;
+    undef %info;
+    undef %tags;
+    undef $current;
+    return 1;
+}
+
+# Add an override. If you specifiy two arguments, the first will be taken
+# as file to add the override to, otherwise 'current' will be assumed
 sub add_override {
-	my $tag = shift;
-	$overrides{$tag} = 0;
+    my ($tag, $file) = ( "", "" );
+    if (@_ > 1) {
+	($file, $tag) = @_;
+    } else {
+	($file, $tag) = ($current, @_);
+    }
+
+    unless ($file) {
+	warn "Don't know which package to add override $tag to";
+	return 0;
+    }
+
+    $info{$file}{overrides}{$tag} = 0;
+
+    return 1;
+}
+
+sub get_overrides {
+    my ($file) = @_;
+
+    unless ($file) {
+	warn "Don't know which package to get overrides from";
+	return undef;
+    }
+
+    return $info{$file}{overrides};
+}
+
+# Get the info hash for a tag back as a reference. The hash will be
+# copied first so that you can edit it safely
+sub get_tag_info {
+    my ( $tag ) = @_;
+    return { %{$tags{$tag}} } if exists $tags{$tag};
+    return undef;
+}
+
+sub check_range {
+    my ( $x, $min, $max ) = @_;
+
+    return -1 if $x < $min;
+    return 1 if $x > $max;
+    return 0;
+}
+
+# check if a certain tag has a override for the 'current' package
+sub check_overrides {
+    my ( $tag_info, $information ) = @_;
+
+    my $extra = '';
+    $extra = " @$information" if @$information;
+    $extra = '' if $extra eq ' ';
+    if( exists $info{$current}{overrides}{$tag_info->{tag}}) {
+	$info{$current}{overrides}{$tag_info->{tag}}++;
+	return $tag_info->{tag};
+    } elsif( exists $info{$current}{overrides}{"$tag_info->{tag}$extra"} ) {
+	$info{$current}{overrides}{"$tag_info->{tag}$extra"}++;
+	return "$tag_info->{tag}$extra";
+    }
+
+    return '';
+}
+
+# sets all the overridden fields of a tag_info hash correctly
+sub check_need_to_show {
+    my ( $tag_info, $information ) = @_;
+    $tag_info->{overridden}{override} = check_overrides( $tag_info,
+							 $information );
+    my $min_sev = $show_info ? 0 : $min_severity; # compat hack
+    $tag_info->{overridden}{severity} = check_range( $tag_info->{severity},
+						     $min_sev,
+						     $max_severity );
+    $tag_info->{overridden}{significance} = check_range( $tag_info->{significance},
+							 $min_significance,
+							 $max_significance );
 }
 
+# records the stats for a given tag_info hash
+sub record_stats {
+    my ( $tag_info ) = @_;
+
+    for my $k (qw( severity significance tag )) {
+	$stats{$current}{$k}{$tag_info->{$k}}++
+	    unless $tag_info->{overridden}{$k};
+    }
+    for my $k (qw( severity significance override )) {
+	$stats{$current}{overrides}{$k}{$tag_info->{overridden}{$k}}++
+	    if $tag_info->{overridden}{$k};
+    }
+}
+
+# get the statistics for a file (one argument) or for all files (no argument)
+sub get_stats {
+    my ( $file ) = @_;
+
+    return $stats{$file} if $file;
+    return \%stats;
+}
+
+sub print_tag {
+    my ( $pkg_info, $tag_info, $information ) = @_;
+
+    my $extra = '';
+    $extra = " @$information" if @$information;
+    $extra = '' if $extra eq ' ';
+    my $code = $codes{$tag_info->{type}};
+    $code = 'O' if $tag_info->{overridden}{override};
+    my $type = '';
+    $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
+
+    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 = shift;
-	my $info = $tags{$tag};
-	return if not $show_info and $info->{'type'} eq 'info';
-	my $extra = '';
-	$extra = ' '.join(' ', @_) if $#_ >=0;
-	$extra = '' if $extra eq ' ';
-	my $code = $codes->{$info->{'type'}};
-	if (exists $overrides{$tag} or exists $overrides{"$tag$extra"}) {
-		return unless $show_overrides or $verbose;
-		$code = 'O';
-	}
+    my ( $tag, @information ) = @_;
+    unless ($current) {
+	warn "Tried to issue tag $tag without setting package\n";
+	return 0;
+    }
 
-	print "$code: $prefix: $tag$extra\n";
+    my $tag_info = get_tag_info( $tag );
+    unless ($tag_info) {
+	warn "Tried to issue unknown tag $tag\n";
+	return 0;
+    }
+    check_need_to_show( $tag_info, \@information );
+
+    record_stats( $tag_info );
+
+    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;
 }
 
 1;