wesnoth/utils/wmlxgettext

#!/usr/bin/perl -w

# FIXME:
# - maybe restrict "ability" matching to unit defs (not yet necessary)
# - maybe handle some xgettext flags and behaviours to be more
#   predictable to the command-line user

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

our $toplevel = '.';
GetOptions ('directory=s' => \$toplevel);

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;

 LINE: while (<FILE>) {
    # skip comments
    next LINE if m/^\s*\#/ and !defined $str;

    if (m/^(?:[^\"]*?)((?:_\s*)?)\"([^\"]*)\"(.*)$/) {
      # single-line quoted string
      die "nested string in $file" if defined $str;

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

      # process remaining of the line
      $_ = $3;
      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;
      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};
  }
}