#!/usr/bin/perl
#
# Debian Archive Overrides Sublimator
#
# Copyright © 2013, 2017-2018 Guillem Jover <guillem@debian.org>
#
# 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, see <https://www.gnu.org/licenses/>.

use strict;
use warnings;
no warnings qw(experimental::smartmatch);
use feature qw(switch state);

my $VERSION = '0.0';

use Getopt::Long qw(:config posix_default bundling no_ignorecase);

use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Cache;

(my $self = $0) =~ s#.*/##;

my %options = (
  help		=> sub { usage(); exit 0 },
  version	=> sub { version(); exit 0 },
  filter	=> undef,
  suite		=> 'experimental|unstable|sid|testing|wheezy',
  format	=> 'detail',
  chunk		=> undef,
  verbose	=> 0,
);

my $bts_from_name = (getpwuid($<))[6] =~ s/,.*$//r;
my $bts_from_mail = $ENV{DEBEMAIL};
my $bts_from = "$bts_from_name <$bts_from_mail>";
my $bts_addr = 'submit@bugs.debian.org';
my $bts_user = 'guardians@namespace.hadrons.org';
my $bts_tags = 'sectionspace-rift';

sub version
{
  print "$self $VERSION\n",
}

sub usage
{
  printf "Usage: %s [options] <file...>

Options:
      --suite=NAME	Set the suite (default: %s).
      --filter=NAME	Set the section filter to use (default: '')
      --format=NAME	Set the output format (default: %s).
                        Supported values: bts, micro, bulk, detail.
      --chunk=N		Chunk output formats by N items (default none).
      --verbose=N	Set the verbose level (default: %d).
  -?, --help		Show this help message.
      --version		Show the version.
", $self, $options{suite}, $options{format}, $options{verbose};
}

my $rc = GetOptions(\%options,
  'help|?',
  'version',
  'filter=s',
  'suite=s',
  'format=s',
  'chunk=i',
  'verbose=i',
);

usage() and exit 1 unless $rc or @ARGV;

# Initialise the global config object with the default values and
# setup the $_system object.
$_config->init;
$_system = $_config->system;

# Suppress cache building messages.
$_config->{quiet} = 2;

# Set up the cache.
my $cache = AptPkg::Cache->new;

sub header
{
  given ($options{format}) {
    when ('bts') {
      print "From: $bts_from\n";
      print "To: $bts_addr\n";
      print 'Subject: override: ';
    }
  }
}

sub footer
{
  given ($options{format}) {
    when ('bts') {
      print "\n\n";
      print "Package: ftp.debian.org\n";
      print "Severity: wishlist\n";
      print "User: ftp.debian.org\@packages.debian.org\n";
      print "Usertags: override\n";
      print "User: $bts_user\n";
      print "Usertags: $bts_tags\n";
    }
  }
}

sub skip
{
  my ($pkgname, $section, $excuse) = @_;

  return if $options{format} ne 'detail';

  print "    skip: $pkgname:$section ($excuse)\n" if $options{verbose} > 0;
}

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

  return if $options{format} ne 'detail';

  print "$line\n" if $options{verbose} > 0;
}

sub override
{
  my ($pkgname, $version, $cursection, $section, $priority) = @_;
  state $chunked = 0;

  return if defined $options{filter} and !($section =~ $options{filter});

  # Normalize priority, Debian does not have extra anymore.
  $priority = 'optional' if $priority eq 'extra';

  given ($options{format}) {
    when ('detail') {
      print "override: $pkgname:$section/$priority ($version ; $cursection)\n";
    }
    when ('bts') {
      print "$pkgname:$section/$priority";
      $chunked++;

      if (defined $options{chunk} and $chunked >= $options{chunk}) {
        $chunked = 0;
        footer();
        print "\n<<==>>\n";
        header();
      } else {
        print ", ";
      }
    }
    when ('micro') {
      print "$pkgname $section\n";
    }
    when ('bulk') {
      print "$pkgname\t$section\t$priority\n";
    }
    default {
      die "format not supported $options{format}\n";
    }
  }
}

sub check_change
{
  my ($pkgname, $section, $oldsection) = @_;

  print "D: $pkgname $section\n" if $options{verbose} > 1;

  # Patterns are not currently supported.
  if ($pkgname =~ m/\*/) {
    skip($pkgname, $section, "pattern");
    return;
  }

  my $pkg = $cache->{$pkgname};
  unless ($pkg) {
    skip($pkgname, $section, "unknown package");
    return;
  }

  my $available = $pkg->{VersionList};
  unless ($available) {
    skip($pkgname, $section, "virtual package");
    return;
  }

  my $cursection = $pkg->{Section};

  if ($cursection =~ m/^$section$/) {
    skip($pkgname, $section, "correct section ; $cursection");
    return;
  }

  if (defined $oldsection and $cursection ne $oldsection) {
    skip($pkgname, $section, "changed section ; $cursection");
    return;
  }

  my $pkg_found = 0;

  FIND_PKG: for my $v (@$available) {
    for my $f (map $_->{File}, @{$v->{FileList}}) {
      if ($f->{Archive} =~ m/$options{suite}/) {
        my $version = $v->{VerStr};
        my $priority = $v->{Priority};

        override($pkgname, $version, $cursection, $section, $priority);

        $pkg_found = 1;
        last FIND_PKG;
      }
    }
  }

  if (!$pkg_found) {
    skip($pkgname, $section, "not in suite = $options{suite}");
  }
}

header();

while (<>) {
  chomp;

  next if /^#/;

  if (/^==== finish ====/) {
    relay($_);
    last;
  }
  if (/^(?:==|--)/) {
    relay($_);
    next;
  }
  if (/^\s*$/) {
    relay('');
    next;
  }

  # Override fix proposal
  if (m{^([*a-z0-9.+-]+)\s+([a-z|/-]+)}) {
    my $pkgname = $1;
    my $section = $2;

    check_change($pkgname, $section);
    next;
  }

  # Override fix proposal w/ check
  if (m{^([*a-z0-9.+-]+)\s+!([a-z/-]+)\s+->\s([a-z|/-]+)}) {
    my $pkgname = $1;
    my $oldsection = $2;
    my $section = $3;

    check_change($pkgname, $section, $oldsection);
    next;
  }
}

footer();

1;