#!/usr/bin/perl

# Generates profiles for the Debian vendor
#  - Remember to add new profiles to d/rules under profiles

use v5.20;
use warnings;
use utf8;

use Cwd qw(realpath);
use File::Basename qw(dirname);

# neither Path::This nor lib::relative are in Debian
use constant THISFILE => realpath __FILE__;
use constant THISDIR => dirname realpath __FILE__;

# use Lintian modules that belong to this program
use lib THISDIR . '/../lib';

use Const::Fast;
use File::Find::Rule;
use List::Compare;
use List::Util qw(uniq);
use LWP::Simple;
use Path::Tiny;
use Unicode::UTF8 qw(encode_utf8);
use YAML::XS;

use Lintian::Deb822::File;

const my $EMPTY => q{};
const my $SPACE => q{ };
const my $INDENT => $SPACE x 4;
const my $NEWLINE => qq{\n};
const my $COMMA => q{,};
const my $HYPHEN => q{-};

$ENV{LINTIAN_BASE} = realpath(THISDIR . '/..')
  // die encode_utf8('Cannot resolve LINTIAN_BASE');

# generate main profile
my $checkdir = "$ENV{LINTIAN_BASE}/lib/Lintian/Check";
my @modulepaths = File::Find::Rule->file->name('*.pm')->in($checkdir);

my @allchecks;
for my $modulepath (@modulepaths) {
    my $relative = path($modulepath)->relative($checkdir)->stringify;
    my ($name) = ($relative =~ qr/^(.*)\.pm$/);

    $name =~ s{([[:upper:]])}{-\L$1}g;
    $name =~ s{^-}{};
    $name =~ s{/-}{/}g;

    push(@allchecks, $name);
}

generate_profile(
    'debian', 'main',
    {
        'Enable-Tags-From-Check' => \@allchecks,
    });

# generate profile for FTP Master auto-reject
my $auto_reject_url = 'https://ftp-master.debian.org/static/lintian.tags';
my $contents = get($auto_reject_url);
die encode_utf8("Couldn't get file from $auto_reject_url")
  unless defined $contents;

my $yaml = Load($contents);
die encode_utf8("Couldn't parse output from $auto_reject_url")
  unless defined $yaml;

my $base = $yaml->{lintian};
die encode_utf8("Couldn't parse document base for $auto_reject_url")
  unless defined $base;

my @want_fatal = uniq @{ $base->{fatal} // [] };
my @want_nonfatal = uniq @{ $base->{nonfatal} // [] };

# find all tags known to Lintian
my @known_tags;
my %new_name;
my $tagroot = "$ENV{LINTIAN_BASE}/tags";
my @descfiles = File::Find::Rule->file()->name('*.tag')->in($tagroot);
for my $tagpath (@descfiles) {

    my $deb822 = Lintian::Deb822::File->new;
    my @sections = $deb822->read_file($tagpath);
    die encode_utf8("Tag in $tagpath does not have at least one paragraph")
      unless @sections;

    my $fields = $sections[0];

    my $name = $fields->value('Tag');
    push(@known_tags, $name);

    my @renamed_from = $fields->trimmed_list('Renamed-From');

    my @taken = grep { exists $new_name{$_} } @renamed_from;

    say encode_utf8(
        "Warning: Ignoring $_ as an alias for $new_name{$_} in favor of $name."
    )for @taken;

    $new_name{$_} = $name for @renamed_from;
}

my $old_fatal_lc= List::Compare->new(\@want_fatal, [keys %new_name]);
my $old_nonfatal_lc= List::Compare->new(\@want_nonfatal, [keys %new_name]);

my @old_fatal_names = $old_fatal_lc->get_intersection;
my @old_nonfatal_names = $old_nonfatal_lc->get_intersection;

say encode_utf8('FTP Master uses old tag names for auto-rejection:')
  if @old_fatal_names || @old_nonfatal_names;
say encode_utf8($INDENT . "-   [fatal]   $_  =>  $new_name{$_}")
  for @old_fatal_names;
say encode_utf8($INDENT . "- [non-fatal] $_  =>  $new_name{$_}")
  for @old_nonfatal_names;

my $new_fatal_lc
  = List::Compare->new(\@want_fatal, [map { $new_name{$_} } @old_fatal_names]);
my $new_nonfatal_lc
  = List::Compare->new(\@want_nonfatal,
    [map { $new_name{$_} } @old_nonfatal_names]);

my @aware_fatal_names = $new_fatal_lc->get_intersection;
my @aware_nonfatal_names = $new_nonfatal_lc->get_intersection;

say encode_utf8('They already know about those tags:')
  if @aware_fatal_names || @aware_nonfatal_names;
say encode_utf8($INDENT . "-   [fatal]   $_") for @aware_fatal_names;
say encode_utf8($INDENT . "- [non-fatal] $_") for @aware_nonfatal_names;

my @unaware_fatal_names = $new_fatal_lc->get_Ronly;
my @unaware_nonfatal_names = $new_nonfatal_lc->get_Ronly;

say encode_utf8('The following tags have to be added:')
  if @unaware_fatal_names || @unaware_nonfatal_names;
say encode_utf8($INDENT . "-   [fatal]   $_") for @unaware_fatal_names;
say encode_utf8($INDENT . "- [non-fatal] $_") for @unaware_nonfatal_names;

# replace old names
@want_fatal = uniq map { $new_name{$_} // $_ } @want_fatal;
@want_nonfatal = uniq map { $new_name{$_} // $_ } @want_nonfatal;

my $fatal_lc = List::Compare->new(\@want_fatal, \@known_tags);
my @unknown_fatal = $fatal_lc->get_Lonly;
my @fatal = $fatal_lc->get_intersection;

my $nonfatal_lc = List::Compare->new(\@want_nonfatal, \@known_tags);
my @unknown_nonfatal = $nonfatal_lc->get_Lonly;
my @nonfatal = $nonfatal_lc->get_intersection;
my @unknown = (@unknown_fatal, @unknown_nonfatal);

say encode_utf8(
    'Warning, disregarding unknown tags for profile ftp-master-auto-reject:')
  if @unknown;
say encode_utf8($INDENT . $HYPHEN . $SPACE . $_) for @unknown;

say encode_utf8('Found '
      . scalar @fatal
      . ' fatal and '
      . scalar @nonfatal
      . ' non-fatal tags for profile ftp-master-auto-reject.');

generate_profile(
    'debian',
    'ftp-master-auto-reject',
    {
        # "lintian" is enabled by default, so we explicitly disable it.
        'Disable-Tags-From-Check' => ['lintian'],
        'Enable-Tags' => [@fatal, @nonfatal],
    },
    {
        'Tags' => \@fatal,
        'Overridable' => ['no'],
    });

exit 0;

sub generate_profile {
    my ($vendor, $name, @paragraphs) = @_;

    my $text =<<"EOSTR";
# This profile is auto-generated
Profile: $vendor/$name
EOSTR

    $text .= write_paragraph($_) for @paragraphs;

    my $folder = "profiles/$vendor";
    path($folder)->mkpath
      unless -d $folder;

    path("$folder/$name.profile")->spew_utf8($text);

    return;
}

sub write_paragraph {
    my ($paragraph) = @_;

    my $text = $EMPTY;

    for my $field (sort keys %{$paragraph}) {
        $text .= "$field:" . $NEWLINE;

        my @values = sort @{$paragraph->{$field}};

        $text .= $SPACE . $_ . $NEWLINE for @values;
    }

    $text .= $NEWLINE
      if length $text;

    return $text;
}

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