#!/usr/bin/perl -w
#
# lintian-info -- transform lintian tags into descriptive text
#
# Copyright (C) 1998 Christian Schwarz and Richard Braakman
#
# This program is free software.  It is distributed 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.

use strict;
use warnings;

use Getopt::Long;

# turn file buffering off:
$| = 1;

BEGIN {
  # determine LINTIAN_ROOT
  my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'} || '/usr/share/lintian';
  $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT
    unless exists $ENV{'LINTIAN_ROOT'};
}

# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Internal::FrontendUtil;
use Lintian::Profile;
use Text_utils;

my %already_displayed = ();
my @proc_inc = (
    "$ENV{HOME}/.lintian/profiles",
    '/etc/lintian/profiles',
    "$ENV{'LINTIAN_ROOT'}/profiles"
);
my ($annotate, $tags, $help, $prof);
my $profile;
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
GetOptions(
    'annotate|a' => \$annotate,
    'tags|t' => \$tags,
    'help|h' => \$help,
    'profile=s' => \$prof,
) or die("error parsing options\n");

# help
if ($help) {
    print <<"EOT";
Usage: lintian-info [log-file...] ...
       lintian-info --annotate [overrides ...]
       lintian-info --tags tag ...

Options:
    -a, --annotate    display descriptions of tags in Lintian overrides
    -t, --tags        display tag descriptions
    --profile X       use vendor profile X to determine severities
EOT

    exit 0;
}

unless ($prof) {
    $prof = find_default_profile(@proc_inc);

}
$profile = Lintian::Profile->new($prof, $ENV{'LINTIAN_ROOT'}, \@proc_inc);

# If tag mode was specified, read the arguments as tags and display the
# descriptions for each one.  (We don't currently display the severity,
# although that would be nice.)
my $unknown;
if ($tags) {
    for my $tag (@ARGV) {
        my $info = $profile->get_tag ($tag, 1);
        if ($info) {
            print $info->code . ": $tag\n";
            print "N:\n";
            print $info->description('text', 'N:   ');
        } else {
            print "N: $tag\n";
            print "N:\n";
            print "N:   Unknown tag.\n";
            $unknown = 1;
        }
        print "N:\n";
    }
    exit ($unknown ? 1 : 0);
}

my $type_re = qr/(?:binary|changes|source|udeb)/o;
# Matches something like:  (1:2.0-3) [arch1 arch2]
# - captures the version and the architectures
my $verarchre = qr,(?: \s* \( [^\)]++ \) \s* \[   [^\]]++  \]),xo;
#                             ^^^^^^^             ^^^^^^^
#                           ( version )       [architecture ]

# matches the full deal:
#                                  111
# -  T: pkg type (version) [arch]: tag [...]
#           ^^^^^^^^^^^^^^^^^^^^^
# Where the marked part(s) are optional values.  The numbers above the example
# are the capture groups.
my $fullre = qr/[EWIXOP]: \S+(?: $type_re(?:$verarchre)?)?: (\S+)(?:\s+.*)?/o;

# Otherwise, read input files or STDIN, watch for tags, and add descriptions
# whenever we see one, can, and haven't already explained that tag.  Strip off
# color and HTML sequences.
while (<>) {
    print;
    chomp;
    next if /^\s*$/;
    s/\e[\[\d;]*m//g;
    s/<span style=\"[^\"]+\">//g;
    s,</span>,,g;

    my $tag;
    my $type;
    if ($annotate) {
        my $tagdata;
        next unless m/^(?:                         # start optional part
                    (?:\S+)?                       # Optionally starts with package name
                    (?: \s*+ \[[^\]]+?\])?         # optionally followed by an [arch-list] (like in B-D)
                    (?: \s*+ $type_re)?            # optionally followed by the type
                  :\s++)?                          # end optional part
                ([\-\.a-zA-Z_0-9]+ (?:\s.+)?)$/ox; # <tag-name> [extra] -> $1
        $tagdata = $1;
        ($tag, undef) = split m/ /o, $tagdata, 2;
    } else {
        next unless m/^$fullre$/o;
        $tag = $1;
    }
    next if $already_displayed{$tag}++;
    my $info = $profile->get_tag ($tag, 1);
    next unless $info;
    print "N:\n";
    print $info->description('text', 'N:   ');
    print "N:\n";
}

exit 0;

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et