--- /dev/null
+#! /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;
projects / maemian / blobdiff