source: main/tags/2.51-jcdl/gsdl/macros/Chktrans.pl@ 25200

#! /usr/bin/perl -w

use strict;

my @languages = ("chinese", "french", "german", "maori", "spanish", "turkish");

print "
Chktrans.pl

This file checks english.dm and english2.dm against 
translations made in other languages.  It outputs 
 whether the translation exists in each language,
 what macros override the English (default) macros
 what macros have not been translated,
 what additional macros exist.

Current languages:
";

foreach my $l (@languages) {
    print " $l\n";
}

print "\nReading english.dm\n";

open(E, "<english.dm");

my $line;
my $count = 0;
my %macro;
my $package="";
while (<E>) {
    chomp;
    $line = $_;
    if ($line =~ /^package\s+(\w+)/) {
    $package="$1:";
    next;
    }
    next unless ($line =~ /^_\w+_ *\{/);
    # don't necessarily have space between macro and { - eg _macro_{content}
    $line =~ s/_\s*\{.*/_/;
    $macro{"$package$line"} = 1;
    $count++;
}

print "Read $count macros.\n\n";

my $file;

foreach my $l (@languages) {
    $file = "$l.dm";

    print "=============================================\nLanguage: $l\n";

    # make sure thwere is a translation for the language
    if (!-e "$file") {
    print "$file doesn't exist\n\n";
    next;
    }
    
    # read the macros in this language
    print "Reading $file\n";
    open(L, "<$file");
    my (%lm, %lmnew, %lr, %lrnew);
    my $lc = 0;
    $package = "";
    while (<L>) {
    chomp;
    $line = $_;
    
    if ($line =~ /^package\s+(\w+)/) {
        $package="$1:";
        next;
    }
    next unless ($line =~ /^_\w+_/);
    next unless ($line =~ /\{/);
    
    $line =~ s/_\s*\{.*/_/;
    # There are four types of macro, the combos of:
    #  With or without macro country code
    #  Present or not present in %macro
    if ($line =~ /\[/) {
# don't need a space between macro and arg (_macro_[args])
#       $line =~ s/\s.*//;
        $line =~ s/\s*\[.*//;
        my $thismacro="$package$line";
        if (defined($macro{$thismacro})) {
        $lm{$thismacro} = $thismacro;
        } else {
        $lmnew{$thismacro} = $thismacro;
        }
    } else {
        my $thismacro="$package$line";
        if (defined($macro{$thismacro})) {
        $lr{$thismacro} = $thismacro;
        } else {
        $lrnew{$thismacro} = $thismacro;
        }
    }
    $lc++;
    }
    close L;
    print "Read $lc macros.\n\n";

    # How many macros operate correctly
    print (scalar keys %lm);
    print" macros are translated from english to $l\n\n";
   
    # What are the new macros?
    if (scalar keys %lmnew) {
    print (scalar keys %lmnew);
    print" macros are new $l macros with no eqivalents in english.dm:\n";
    foreach my $m (sort (keys (%lmnew))) {
        print "$m ";
    }
    print "\n\n";
    }

    # What are the new macros?
    if (scalar keys %lrnew) {
    print (scalar keys %lrnew);
    print" macros are new macros in english that do not appear in english.dm:\n";
    foreach my $m (sort (keys (%lrnew))) {
        print "$m ";
    }
    print "\n\n";
    }

    # Which languages override their english counterparts?
    if (scalar keys %lr) {
    print (scalar keys %lr);
    print" macros override equivalents in english.dm ";
    print"(It doesn't matter if you override macros like widths, heights, and URLs):\n";
    foreach my $m (sort (keys (%lr))) {
        print "$m ";
    }
    print "\n\n";
    }

    # Which macros in english.dm do not appear in the newfile?
    my @missing = ();
    foreach my $m (sort (keys (%macro))) {
    next if defined($lm{$m});
    push @missing, $m;
    }
    if (scalar @missing) {
    print (scalar @missing);
    print " macros in english.dm have no entry in $l.dm:\n";
    foreach my $m (sort @missing) {
        print "$m ";
    }
    print "\n\n";
    }

    print "\n";

}