#!/usr/bin/perl
#
# annotate-lintian-hints -- transform lintian tags into descriptive text
#
# Copyright © 1998 Christian Schwarz and Richard Braakman
# Copyright © 2013 Niels Thykier
# Copyright © 2017 Chris Lamb <lamby@debian.org>
# Copyright © 2020 Felix Lechner
#
# 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 v5.20;
use warnings;
use utf8;

# use Lintian modules that belong to this program
use FindBin;
use lib "$FindBin::RealBin/../lib";

# substituted during package build
my $LINTIAN_VERSION;

use Cwd qw(getcwd realpath);
use File::BaseDir qw(config_home config_files data_home);
use File::Basename;
use Getopt::Long ();

use Lintian::Output::EWI;
use Lintian::Profile;
use Lintian::Version qw(guess_version);

use constant EMPTY => q{};

binmode(STDOUT, ':encoding(UTF-8)');

if (my $coverage_arg = $ENV{'LINTIAN_COVERAGE'}) {
    my $p5opt = $ENV{'PERL5OPT'}//EMPTY;
    $p5opt .= ' ' if $p5opt ne EMPTY;
    $ENV{'PERL5OPT'} = "${p5opt} ${coverage_arg}";
}

$ENV{LINTIAN_BASE} = realpath("$FindBin::RealBin/..")
  // die 'Cannot resolve LINTIAN_BASE';

my $annotate;
my @INCLUDE_DIRS;
my $profile_name;
my $user_dirs = 1;

my %options = (
    'annotate|a' => \$annotate,
    'help|h' => \&show_help,
    'include-dir=s' => \@INCLUDE_DIRS,
    'profile=s' => \$profile_name,
    'user-dirs!' => \$user_dirs,
    'version' => \&show_version,
);

Getopt::Long::Configure('gnu_getopt');
Getopt::Long::GetOptions(%options)
  or die "error parsing options\n";

# only absolute paths
my @RESTRICTED_CONFIG_DIRS;

if ($user_dirs) {
    my $data_home;
    my $legacy_user_data;

    $data_home = data_home('lintian')
      if exists $ENV{'HOME'} || exists $ENV{'XDG_CONFIG_HOME'};

    $legacy_user_data = "$ENV{HOME}/.lintian"
      if exists $ENV{'HOME'};

    if (defined($data_home) and $data_home !~ m@^/@) {
        # Turn the path into an absolute one.  Just in case
        # someone sets a relative HOME dir.
        my $cwd = getcwd();
        $data_home = "${cwd}/${data_home}";
    }

    @RESTRICTED_CONFIG_DIRS = grep { -d }
      grep { length } ($data_home, $legacy_user_data, '/etc/lintian');
}

# only absolute paths
my @CONFIG_DIRS = grep { -d }
  grep { length } map { realpath($_) } ($ENV{'LINTIAN_BASE'}, @INCLUDE_DIRS);

my $profile = Lintian::Profile->new;
$profile->load($profile_name, \@CONFIG_DIRS,
    { 'restricted-search-dirs' => \@RESTRICTED_CONFIG_DIRS });

my $output = Lintian::Output::EWI->new;

# Matches something like:  (1:2.0-3) [arch1 arch2]
# - captures the version and the architectures
my $verarchre = qr,(?: \s* \(( [^)]++ )\) \s* \[ ( [^]]++ ) \]),xo;

# matches the full deal:
#    1  222 3333  4444444   5555   666  777
# -  T: pkg type (version) [arch]: tag [...]
#           ^^^^^^^^^^^^^^^^^^^^^
# Where the marked part(s) are optional values.  The numbers above
# the example are the capture groups.
my $TAG_REGEX
  = qr/([EWIXOPC]): (\S+)(?: (\S+)(?:$verarchre)?)?: (\S+)(?:\s+(.*))?/;

my $type_re = qr/(?:binary|changes|source|udeb)/;

my %already_displayed;

# 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.
for my $line (<STDIN>) {
    print $line;
    chomp $line;

    next
      if $line =~ /^\s*$/;

    $line =~ s/\e[\[\d;]*m//g;
    $line =~ s/<span style=\"[^\"]+\">//g;
    $line =~ s,</span>,,g;

    my $tag_name;
    if ($annotate) {

        next
          unless $line =~ /^(?:                    # 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.+)?)$/x;  # <tag-name> [extra] -> $1

        my $tagdata = $1;
        ($tag_name, undef) = split(/ /, $tagdata, 2);

    } else {
        my @parts = split_tag($line);
        next
          unless @parts;

        $tag_name = $parts[5];
    }

    next
      if $already_displayed{$tag_name}++;

    my $tag = $profile->get_tag($tag_name);
    next
      unless defined $tag;

    $output->describe_tags($tag);
}

exit;

=item split_tag

=cut

sub split_tag {
    my ($line) = @_;

    return
      unless $line =~ /^${TAG_REGEX}$/;

    my $pkg_type = $3 // 'binary';

    return ($1, $2, $pkg_type, $4, $5, $6, $7);
}

sub show_version {
    my $version = $LINTIAN_VERSION // guess_version($ENV{LINTIAN_BASE});

    die 'Unable to determine the version automatically!?'
      unless length $version;

    say "annotate-lintian-hints v$version";
    exit;
}

sub show_help {
    print <<"EOT";
Usage: annotate-lintian-hints [log-file...] ...
       annotate-lintian-hints --annotate [overrides ...]

Options:
    -a, --annotate     display descriptions of tags in Lintian overrides
    --profile X        use vendor profile X to determine severities
    --include-dir DIR  check for Lintian data in DIR
    --[no-]user-dirs   whether to include profiles from user directories
    --version          show version info and exit
EOT
    exit;
}

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