#!/usr/bin/env perl

use warnings;

my $lang;
my @files;

for (@ARGV)
{
    if (/^-v$/)
    {
        $verbose = 1;
    }
    # Hack: no two-letter names are allowed, as these are assumed to be lang.
    elsif (/^([a-z][a-z])$/)
    {
        die "One language at a time, please.\n" if $lang;
        $lang = $1;
    }
    else
    {
        s/\.txt$//;
        die "Arg not a lang nor a filename: '$_'.\n" unless m{^([/a-z0-9_-]+)$}i; #/
        push @files, $1;
    }
}

sub good_file()
{
    return grep { $file =~ m{\b$_\b} } @files;
}

sub err($)
{
    print $_[0];
}

sub __________________________________________________________________________
{
    %entries = (); # per-db
    %source = (); # file:line
    %keys = (); # per-file
}

sub read_file($)
{
    my $skip = !!@files;
    ($file) = @_;
    $skip = 0 if good_file();
    $file =~ s|/|/$lang/| if $lang;
    $skip = 0 if good_file();
    return if $skip;
    $file = "dat/$file.txt";

    %keys = ();
    $line = 0;
    return $lang ? 0 : die "Can't read $file\n" unless open F, "<", $file;
    ($key, $value) = ();
    local $_;

    print "Checking $file\n" if $verbose;

    sub add_key()
    {
        err "Duplicate entry: '$key' at $source{$key} and $file:$line\n"
            if $source{$key};
        $source{$key} = "$file:$line";
        $entries{$key} = $value;
        $keys{$key} = 1;

        undef $key;
        undef $value;
    }

    while (<F>)
    {
        next if /^#/;
        s/\s+$//;

        if (/^%%%%/)
        {
            if (defined $key)
            {
                defined($value)
                ? add_key()
                : err("Incomplete entry '$key' at $file:$line\n");
            }
            next;
        }

        unless (defined $key)
        {
            next if /^$/;
            $key = $_;
            $line = $.; # report the start not end of a desc
        }
        else
        {
            next if /^$/ && !defined $value;
            $value .= $_;
        }
    }

    if (defined $key)
    {
        defined($value)
        ? add_key()
        : err("Incomplete entry '$key' at the end of '$file'\n");
    }

    close F;
    return 1;
}

sub check_desc_needed($@)
{
    my ($kind, @needed) = @_;
    for (@needed)
    {
        chomp;
        err "$file: No description for $kind '$_'\n" unless $entries{$_};
        delete $keys{$_};
    }
    for (sort keys %keys)
    {
        err "$file: Unused description for $kind '$_'\n" unless /^_/;
    }
}

sub check_desc_links()
{
    for (keys %entries)
    {
        next unless $entries{$_} =~ /^<([^>\n]*)>$/;
        err "$source{$_}: Dangling link '$_' -> '$1'\n" unless $entries{$1};
    }
}

sub check_db_locals()
{
    my (%locals, %keys);
    $keys{$_}=1 for keys %entries;
    $locals{$_}=1 for map /@(_[^@\n]+_)@/g, values %entries;
    for (sort keys %locals)
    {
        err("Undefined local entry '$_'\n") unless $entries{$_};
        delete $keys{$_};
    }
    err("Unused local entry '$_' at $source{$_}\n") for grep /^_.*_$/, keys %keys;
}

sub check_db_externs(@)
{
    my (%externs, %used, %keys);
    $externs{$_}=1 for @_;
    $keys{$_}=1 for keys %entries;
    $used{$_}=1 for grep !/^_/, map /@([^@\n]+)@/g, values %entries;
    for (sort keys %used)
    {
        err("Undefined entry '$_'\n") unless $entries{$_} || $externs{$_};
        delete $keys{$_};
    }
}

sub check_db_needed($@)
{
    my ($kind, @needed) = @_;
    for (@needed)
    {
        chomp;
        err "$file: No $kind entry for '$_'\n" unless $entries{$_};
        delete $keys{$_};
    }
    err "$file: Unused entry for '$_'\n" for grep !/^_.*_$/, sort keys %keys;
}

sub at_at_replaces($$)
{
    my ($file, $func) = @_;
    open F, '<', $file or die;
    undef local $/;
    local $_ = <F>;
    close F;
    /^[^ ].* $func\((.*?)^}/sm or die "No $func() in $file.\n";
    $_ = $1;
    return /@([A-Za-z0-9_,-]+)@/g;
}

my @monspeak_at_at = at_at_replaces("mon-util.cc", "do_mon_str_replacements");

my @gods = ("the Shining One", "Sif Muna","Nemelex Xobeh", "Wu Jian", qw(
            Ashenzari Beogh Cheibriados Dithmenos Elyvilon Fedhas Gozag
            Hepliaklqana Jiyva Kikubaaqudgha Lugonu Makhleb Okawaru Pakellas
            Qazlal Ru Trog Uskayaw Vehumet Xom Yredelemnul Zin));

sub godspeak_keys()
{
    undef local $/;
    open F, "<xom.cc" or die "Can't read xom.cc\n";
    $_ = <F>;
    close F;
    my %keys;
    $keys{"Xom $_"}=1 for m{_get_xom_speech\("([^"]+)"\)}g;
    $keys{"Xom $_"}=1 for m{XOM_SPEECH\("([^"]+)"\)}g;
    $keys{"Xom bored"}=1;
    for (@gods)
    {
        $keys{"$_ newgame"}=1;
        $keys{"$_ welcome"}=1;
        $keys{"$_ penance"}=1;
        $keys{"$_ prayer"}=1;
    }
    $keys{$_}=1 for ("Pakellas death", "recite_closure");
    return keys %keys;
}
__________________________________________________________________________();
read_file("descript/unident");
read_file("descript/skills");
read_file("descript/commands");

if (read_file("descript/gods"))
{
    check_desc_needed("god", map {($_, "$_ powers", "$_ wrath")} @gods);
}

if (read_file("descript/items"))
{
    check_desc_needed("item", `util/gather_items -d`);
}

if (read_file("descript/branches"))
{
    check_desc_needed("branch", `util/gather_branches`);
}

if (read_file("descript/features"))
{
    $entries{"A gate leading to a distant place"} = 1;
    check_desc_needed("feature", grep {!/explore horizon$/} `util/gather_features -a`);
}

if (read_file("descript/clouds"))
{
    check_desc_needed("cloud", `util/gather_clouds`);
}

if (read_file("descript/unrand"))
{
    delete $keys{'Screaming Sword'};
    delete $keys{'Sulking Sword'};
    check_desc_needed("unrand", grep {!/^DUMMY/} map {s/^NAME:\s+// && $_}
        `grep ^NAME: art-data.txt`)
}

if (read_file("descript/cards"))
{
    delete $keys{'a buggy card'};
    delete $keys{'a very buggy card'};
    check_desc_needed("card", map {s/$/ card/ && $_} `util/gather_cards`);
}

if (read_file("descript/ability"))
{
    check_desc_needed("ability", sort map {chomp;"$_ ability"}
        `util/gather_abilities`);
}

if (read_file("descript/spells"))
{
    check_desc_needed("spell", sort map {chomp;"$_ spell"} `util/gather_spells`);
}

if (read_file("descript/monsters"))
{
    $entries{$_} = 1 for
    (
        # described with a suffix
        'the Serpent of Hell',
        # overridden descriptions
        'player illusion',
        # replacement for removed creatures
        'ghost',
        # species-only monsters
        'elephant slug', 'hell lord',
    );
    delete $keys{'__(_suffix_examine'};
    delete $keys{"the Serpent of Hell $_"} for qw(gehenna cocytus dis tartarus);
    delete $keys{"__cap-${_}_suffix"} for 'A'..'Z';
    check_desc_needed("monster", `util/gather_mons -d`);
}

check_desc_links();
$described{$_} = 1 for keys %entries;
__________________________________________________________________________();
if ($lang)
{
    # Quotes may be already translated even if the desc they're appended to
    # is not yet.
    my $real_lang = $lang;
    undef $lang;
    read_file("descript/$_") for qw(features items unident unrand monsters spells
        gods branches skills ability cards commands clouds);
    $described{$_} = 1 for keys %entries;
    $lang = $real_lang;
}
__________________________________________________________________________();
# These go to GameStartDB rather than DescriptionDB.
if (read_file("descript/species"))
{
    check_desc_needed("species", `util/gather_species -d`);
}

if (read_file("descript/backgrounds"))
{
    check_desc_needed("background", `util/gather_backgrounds`);
}
__________________________________________________________________________();
read_file("database/$_") for qw(randname rand_wpn rand_arm rand_all randbook monname);
check_db_locals();
__________________________________________________________________________();
read_file("database/$_") for qw(monspeak monspell monflee wpnnoise insult);
check_db_locals();
#check_db_externs(@monspeak_at_at);

if (read_file("database/godspeak"))
{
    $entries{"$_ newgame"}=1 for @gods; # not mandatory
    $entries{"$_ penance"}=1 for @gods; # not mandatory
    $entries{"$_ prayer"}=1 for @gods; # not mandatory
    check_db_needed("godspeak", godspeak_keys());
}
__________________________________________________________________________();
read_file("database/$_") for qw(shout insult);
check_db_locals();
check_db_externs(@monspeak_at_at);
__________________________________________________________________________();
read_file("descript/quotes");
check_desc_links();
if (%described) # can't check unless descs are loaded
{
    for (keys %entries)
    {
        next if /^__(?:cap-[A-Z]|[a-z])_suffix$/;
        err "$file: quote for undescribed '$_'\n" unless $described{$_};
    }
}
__________________________________________________________________________();
read_file("database/help");
__________________________________________________________________________();
read_file("database/FAQ");
__________________________________________________________________________();
read_file("descript/hints");
read_file("descript/tutorial");
check_desc_links();
