#!/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 LWP::Simple qw(get);
use POSIX qw(strftime);

BEGIN {
    my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
    if (not $LINTIAN_ROOT) {
        use Cwd ();
        $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
    } else {
        chdir $LINTIAN_ROOT or die "Cannot chdir to $LINTIAN_ROOT: $!\n";
    }
}

our $YAML_URL = 'http://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(NONFATAL, '>', 'data/output/ftp-master-nonfatal')
    or die "Cannot create data/output/ftp-master-nonfatal: $!\n";
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(@nonfatal), '');
close NONFATAL;
open(FATAL, '>', 'data/output/ftp-master-fatal')
    or die "Cannot create data/output/ftp-master-fatal: $!\n";
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(@fatal), '');
close FATAL;

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