mirror of
https://github.com/wesnoth/wesnoth
synced 2025-04-24 07:36:01 +00:00
117 lines
3.2 KiB
Perl
Executable File
117 lines
3.2 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# Copyright (C) 2003 by Yann Dirson <ydirson@altern.org>
|
|
# Part of the Battle for Wesnoth Project http://wesnoth.org/
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License.
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY.
|
|
#
|
|
# See the COPYING file for more details.
|
|
|
|
# This script updates the language-selection dialog in
|
|
# src/language.cpp to add static tags about the translation status for
|
|
# each language.
|
|
#
|
|
# It uses the "postats" tool from the "potool" package.
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use File::Copy qw(move);
|
|
|
|
my @coredomains = ('wesnoth', 'wesnoth-lib', 'wesnoth-httt');
|
|
|
|
open LANG, "<src/language.cpp"
|
|
or die "cannot open src/language.cpp";
|
|
|
|
open NEW, ">src/language.cpp.new"
|
|
or die "cannot open src/language.cpp.new";
|
|
|
|
my (@complete, @partial, @incomplete);
|
|
|
|
my $started=0;
|
|
while (<LANG>) {
|
|
# wait to be sure we are in the right array
|
|
if (m/^language_def known_languages/) {
|
|
$started = 1;
|
|
print NEW ;
|
|
next;
|
|
}
|
|
print NEW and next unless $started;
|
|
|
|
# quit at end of array
|
|
last if m/^$/;
|
|
|
|
if (m/^(.*language_def)\("(\w\w+)", "([^\(]*(?: \([^\(\d]*\))?)(?: \(.+\))?"\)(.*)$/) {
|
|
# print " /*$1\"$2\", \"$3\"$4 */\n";
|
|
my ($prefix, $locale, $langname, $suffix) = ($1, $2, $3, $4);
|
|
my $langcode = $locale;
|
|
unless (-r "po/wesnoth/${langcode}.po") {
|
|
($langcode, undef) = split /_/, $locale;
|
|
}
|
|
|
|
my @scorestrings;
|
|
|
|
# official score
|
|
my $stat = `postats po/wesnoth*/${langcode}.po | grep ^x`;
|
|
$stat =~ m/x.*x.*\((\d+)%\)/;
|
|
my $score = $1;
|
|
if ($score < 100) {
|
|
unshift @scorestrings, "$score\%";
|
|
}
|
|
|
|
# core score
|
|
my $files = join ' ', map { "po/$_/${langcode}.po" } @coredomains;
|
|
$stat = `postats $files | grep ^x`;
|
|
$stat =~ m/x.*x.*\((\d+)%\)/;
|
|
my $corescore = $1;
|
|
if ($corescore < 100 or $score < 98) {
|
|
unshift @scorestrings, "$corescore\%";
|
|
}
|
|
|
|
my $scorestring = join ' / ', @scorestrings;
|
|
if ($corescore < 98) {
|
|
push @incomplete, [ $prefix, "\"$locale\"", $langname, " (incomplete: $scorestring)", $suffix ] ;
|
|
} elsif ($score < 98) {
|
|
push @partial, [ $prefix, "\"$locale\"", $langname, " (partial: $scorestring)", $suffix ] ;
|
|
} elsif ($scorestring ne '') {
|
|
push @complete, [ $prefix, "\"$locale\"", $langname, " ($scorestring)", $suffix ] ;
|
|
} else {
|
|
push @complete, [ $prefix, "\"$locale\"", $langname, '', $suffix ] ;
|
|
}
|
|
|
|
} else {
|
|
print NEW;
|
|
}
|
|
}
|
|
|
|
sub compare {
|
|
my $a1 = $a->[2];
|
|
my $b1 = $b->[2];
|
|
if ($a1 =~ m/.* \((.*)\)/) {
|
|
$a1 = $1;
|
|
}
|
|
if ($b1 =~ m/.* \((.*)\)/) {
|
|
$b1 = $1;
|
|
}
|
|
$a1 cmp $b1;
|
|
}
|
|
|
|
# do print them in order
|
|
foreach my $def ((sort compare @complete), (sort compare @partial), (sort compare @incomplete)) {
|
|
printf NEW "%s(%-7s, \"%s%s\")%s\n", @$def;
|
|
}
|
|
|
|
print NEW $_; # end of array marker
|
|
while (<LANG>) { print NEW };
|
|
|
|
close NEW;
|
|
close LANG;
|
|
|
|
move ("src/language.cpp","src/language.cpp.bak") or
|
|
die "cannot rename src/language.cpp to src/language.cpp.bak";
|
|
move ("src/language.cpp.new","src/language.cpp") or
|
|
die "cannot rename src/language.cpp.new to src/language.cpp";
|