#!/usr/bin/perl -w

# FIXME:
# - maybe restrict "ability" matching to unit defs (not yet necessary)

use strict;
use File::Basename;
use POSIX qw(strftime);
use Getopt::Long;

our $toplevel = '.';
our $initialdomain = 'wesnoth';
our $domain = undef;
GetOptions ('directory=s' => \$toplevel,
	    'initialdomain=s' => \$initialdomain,
	    'domain=s' => \$domain);

$domain = $initialdomain unless defined $domain;

our $module = dirname ($0) . "/wmltrans.pm";
eval "require \"$module\";";

## extract strings with their refs into %messages

our ($str,$translatable,$line,%messages);
chdir $toplevel;
foreach my $file (@ARGV) {
  open (FILE, "<$file") or die "cannot read from $file";
  my $readingattack = 0;
  my @domainstack = ($initialdomain);
  my ($is_define, $macro_has_textdomain) = (0, 0);
 LINE: while (<FILE>) {
    # record a #define scope
    if (m/\#define\>/) {
      $is_define = 1; $macro_has_textdomain = 0;
      next LINE;
    } elsif (m/\#enddef\>/) {
      $is_define = 0;
      if ($macro_has_textdomain) { shift @domainstack; };
    }

    # change the current textdomain when hitting the directive
    if (m/\#textdomain\s+(\S+)/) {
      unshift @domainstack, $1;
      if ($is_define) { $macro_has_textdomain = 1; };
      next LINE;
    }

    # skip other # lines as comments
    next LINE if m/^\s*\#/ and !defined $str;

    next LINE unless $domainstack[0] eq $domain;

    if (!defined $str and m/^(?:[^\"]*?)((?:_\s*)?)\"([^\"]*)\"(.*)/) {
      # single-line quoted string

      push @{$messages{raw2postring($2)}}, "$file:$."
	if ($1 ne ''); # ie. translatable

      # process remaining of the line
      $_ = $3 . "\n";
      redo LINE;

    } elsif (!defined $str and m/^(?:[^\"]*?)((?:_\s*)?)\s*\"([^\"]*)/) {
      # start of multi-line

      $translatable = ($1 ne '');
      $_ = $2;
      if (m/(.*)\r/) { $_ = "$1\n"; }
      $str = $_;
      $line = $.;

    } elsif (m/(.*?)\"(.*)/) {
      # end of multi-line
      die "end of string without a start in $file" if !defined $str;

      $str .= $1;

      push @{$messages{"\"\"\n" . raw2postring($str)}}, "$file:$."
	if $translatable;
      $str = undef;

      # process remaining of the line
      $_ = $2 . "\n";
      redo LINE;

    } elsif (defined $str) {
      # part of multi-line
      if (m/(.*)\r/) { $_ = "$1\n"; }
      $str .= $_;

    } elsif (m/(\S+)\s*=\s*(.*?)\s*$/) {
      # single-line non-quoted string
      die "nested string in $file" if defined $str;

      # magic handling of weapon descriptions
      push @{$messages{raw2postring($2)}},  "$file:$."
	if $readingattack and
	  ($1 eq 'name' or $1 eq 'type' or $1 eq 'special');

      # magic handling of unit abilities
      push @{$messages{raw2postring($2)}},  "$file:$."
	if $1 eq 'ability';

    } elsif (m,\[attack\],) {
      $readingattack = 1;
    } elsif (m,\[/attack\],) {
      $readingattack = 0;
    }

  }

  close FILE;
}


## index strings by their location in the source so we can sort them

our @revmessages;
foreach my $key (keys %messages) {
  foreach my $line (@{$messages{$key}}) {
    my ($file, $lineno) = split /:/, $line;
    push @revmessages, [ $file, $lineno, $key ];
  }
}

# sort them
@revmessages = sort { $a->[0] cmp $b->[0] or $a->[1] <=> $b->[1] } @revmessages;


## output

my $date = strftime "%F %R%z", localtime();

print <<EOH
msgid ""
msgstr ""
"Project-Id-Version: PACKAGE VERSION\\n"
"Report-Msgid-Bugs-To: http://bugs.wesnoth.org/\\n"
"POT-Creation-Date: $date\\n"
EOH
;
# we must break this string to avoid triggering a bug in some po-mode
# installations, at save-time for this file
print "\"PO-Revision-Date: YEAR-MO-DA ", "HO:MI+ZONE\\n\"\n";
print <<EOH
"Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n"
"Language-Team: LANGUAGE <LL\@li.org>\\n"
"MIME-Version: 1.0\\n"
"Content-Type: text/plain; charset=UTF-8\\n"
"Content-Transfer-Encoding: 8bit\\n"

EOH
;

foreach my $occurence (@revmessages) {
  my $key = $occurence->[2];
  if (defined $messages{$key}) {
    print "#:";
    foreach my $line (@{$messages{$key}}) {
      print " $line";
    }
    print "\nmsgid $key",
      "msgstr \"\"\n\n";

    # be sure we don't output the same message twice
    delete $messages{$key};
  }
}