#!/usr/bin/perl
#
# refresh-ftp-master-tags -- Refresh Lintian data about ftp-master reject tags
#
# Copyright © 2009 Russ Allbery
# Copyright © 2018 Chris Lamb <lamby@debian.org>
#
# 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;

# Not a B-D and script is compile tested...
require LWP::Simple;
LWP::Simple->import(qw(get));

use Const::Fast;
use POSIX qw(strftime);
use Unicode::UTF8 qw(encode_utf8);

use List::SomeUtils qw(uniq);

const my $EMPTY => q{};

our $YAML_URL = 'https://ftp-master.debian.org/static/lintian.tags';

# Retrieve the YAML file that determines which ftp-master tags warrant a
# reject and then parse it.  We should probably use a real YAML parser, but
# that requires every Lintian maintainer to install it.
my $yaml = get($YAML_URL);
die encode_utf8("Cannot retrieve $YAML_URL\n")
  unless $yaml;
my @yaml = split(/\n+/, $yaml);
shift @yaml while (@yaml and $yaml[0] =~ /^\s*$/);
die encode_utf8("Unknown YAML file format (first line: $yaml[0])\n")
  unless $yaml[0] =~ /^\s*lintian:\s*$/;
shift @yaml;
my (@nonfatal, @fatal, $current);

for my $line (@yaml) {
    if ($line =~ /^\s*nonfatal:\s*$/) {
        $current = \@nonfatal;
    } elsif ($line =~ /^\s*fatal:\s*$/) {
        $current = \@fatal;
    } elsif ($line =~ /^\s*-\s+(\S+)\s*$/) {
        die encode_utf8("Tag listed outside of section\n")
          unless $current;
        push(@{$current}, $1);
    } else {
        die encode_utf8("Unrecognized line: $line\n");
    }
}

# Print out the fatal and nonfatal tags to our data files.
my $date = strftime('%Y-%m-%d', gmtime);

my $nonfatal_file = 'private/build-time-data/ftp-master-nonfatal';
open(my $nonfatal, '>', $nonfatal_file)
  or die encode_utf8("Cannot open $nonfatal_file");

print {$nonfatal} encode_utf8(<<"EOH");
# This file lists all tags that cause an automatic reject on upload but can
# be overridden (nonfatal tags).  It is based on the data file retrieved from
# $YAML_URL
#
# Last updated: $date

EOH
print {$nonfatal} encode_utf8(join("\n", sort(uniq(@nonfatal)), $EMPTY));
close($nonfatal);

my $fatal_file = 'private/build-time-data/ftp-master-fatal';
open(my $fatal, '>', $fatal_file)
  or die encode_utf8("Cannot open $fatal_file");

print {$fatal} encode_utf8(<<"EOH");
# This file lists all tags that cause an automatic reject on upload and cannot
# be overridden.  It is based on the data file retrieved from
# $YAML_URL
#
# Last updated: $date

EOH
print {$fatal} encode_utf8(join("\n", sort(uniq(@fatal)), $EMPTY));
close($fatal);

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