#!/usr/bin/perl
#
# refresh-ftp-master-tags -- Refresh Lintian data about ftp-master reject tags
#
# Copyright 2009 Russ Allbery
#
# 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 autodie;

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

use List::MoreUtils qw(uniq);

BEGIN {
    my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
    if (not $LINTIAN_ROOT) {
        require Cwd;
        $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
    } else {
        chdir($LINTIAN_ROOT);
    }
}

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 "Cannot retrieve $YAML_URL\n" unless $yaml;
my @yaml = split(/\n+/, $yaml);
shift @yaml while (@yaml and $yaml[0] =~ /^\s*$/);
die "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 "Tag listed outside of section\n" unless $current;
        push(@$current, $1);
    } else {
        die "Unrecognized line: $line\n";
    }
}

# Print out the fatal and nonfatal tags to our data files.
my $date = strftime('%Y-%m-%d', gmtime);
open(my $nonfatal, '>', 'private/build-time-data/ftp-master-nonfatal');
print {$nonfatal} <<"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} join("\n", sort(uniq(@nonfatal)), '');
close($nonfatal);
open(my $fatal, '>', 'private/build-time-data/ftp-master-fatal');
print {$fatal} <<"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} join("\n", sort(uniq(@fatal)), '');
close($fatal);

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