oddmuse/stuff/oddtrans

#!/usr/bin/perl
# Based on umtrans.pl version 1.0 (April 8, 2001) by Clifford Adams.
# Extracts translation strings from wiki script and extensions.

use strict;
use warnings;
use v5.10;
use utf8;

binmode(STDOUT, ":encoding(UTF-8)");

my $help = q{
NAME
       oddtrans - complement translation tables for Oddmuse

SYNOPSIS
       oddtrans [OPTIONS]... [FILE]...

DESCRIPTION

       Read all the calls to T(), Ts(), and Tss() from all FILEs, and print
       them on standard output, followed by their translation (usually the
       empty string unless you use -l to load a library).

       -l
              load a library from a previous run; you can use multiple -l

EXAMPLES

       oddtrans -l german-utf8.pl wiki.pl modules/*.pl > new-german-utf8.pl

};

our %Translate = ();

my $arg = shift;
while ($arg =~ /^-l/) {
  my $file;
  $file = substr($arg, 3) if length($arg) > 2;
  $file = shift unless $file;
  die $help unless -f $file;
  my %backup = %Translate;
  header_info_extract($file); # keep the header information of the translation files
  do $file or die "Cannot do $file";
  foreach my $key (keys %Translate) {
    $backup{$key} = $Translate{$key};
  }
  %Translate = %backup;
  $arg = shift;
}
unshift(@ARGV, $arg); # shove the last one back because it is not -l!

print "our \%Translate = grep(!/^#/, split(/\\n/,<<'END_OF_TRANSLATION'));\n";
undef $/; # slurp
foreach my $file (@ARGV) {
  open(my $fh, "<:encoding(UTF-8)", $file) or die "Cannot open $file: $!";
  $_ = <$fh>;
  # join split strings
  s/'\s*\.\s*'//g;
  s/"\s*\.\s*"//g;
  # extract calls to T, Ts and Tss
  while(/Ts?s?\(\'([^']+)/g) { trans($file, $1); }
  while(/Ts?s?\(\"([^"]+)/g) { trans($file, $1); }
}

print "#\nEND_OF_TRANSLATION\n";

my %seen = ();
my %read = ();

sub trans {
  my ($file, $string) = @_;
  my ($result);
  $result = '';
  $result = $Translate{$string}  if (defined($Translate{$string}));
  return ' '  if ($seen{$string});
  marker($file) unless $read{$file};
  $seen{$string} = 1;
  print $string . "\n" . $result . "\n";
  return ' ';
}

sub marker {
  my $file = shift;
  $read{$file} = 1;
  # place marker
  print "#" x 80, "\n";
  print "# $file\n";
  print "#" x 80, "\n";
}
my $header = 0;

sub header_info_extract {
  return if $header++;
  my $file = shift;
  open(FILE, "<:encoding(utf8)", $file) or die "Can't open $file because: $!";
  foreach (<FILE>) {
    last if (/^our %Translate = /);
    print;
  }
  close FILE;
}

sub AddModuleDescription {
  # Do nothin; this function is just there such that the translation
  # files can be run.
}