#!@INTLTOOL_PERL@ -w
#
# The Intltool Message Updater
#
# Copyright (C) 2000-2002 Free Software Foundation.
#
# Intltool is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# version 2 published by the Free Software Foundation.
#
# Intltool is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
#
# Authors: Kenneth Christiansen <kenneth@gnu.org>
# Maciej Stachowiak
# Darin Adler <darin@bentspoon.com>
## Release information
my $PROGRAM = "intltool-update";
my $VERSION = "0.18";
my $PACKAGE = "intltool";
## Loaded modules
use strict;
use Getopt::Long;
use Cwd;
use File::Copy;
use File::Find;
## Scalars used by the option stuff
my $HELP_ARG = 0;
my $VERSION_ARG = 0;
my $DIST_ARG = 0;
my $POT_ARG = 0;
my $HEADERS_ARG = 0;
my $MAINTAIN_ARG = 0;
my $REPORT_ARG = 0;
my $VERBOSE = 0;
my $GETTEXT_PACKAGE = "";
my @languages;
my %po_files_by_lang = ();
# Regular expressions to categorize file types.
# FIXME: Please check if the following is correct
my $xml_extension =
"xml(\.in)*|". # .in is not required
"ui|".
"glade2?(\.in)*|". # .in is not required
"scm(\.in)*|". # .in is not required
"oaf(\.in)+|".
"etspec|".
"sheet(\.in)+|".
"pong(\.in)+";
my $ini_extension =
"desktop(\.in)+|".
"caves(\.in)+|".
"directory(\.in)+|".
"soundlist(\.in)+|".
"keys(\.in)+|".
"server(\.in)+";
## Always print as the first thing
$| = 1;
## Handle options
GetOptions
(
"help" => \$HELP_ARG,
"version" => \$VERSION_ARG,
"dist|d" => \$DIST_ARG,
"pot|p" => \$POT_ARG,
"headers|s" => \$HEADERS_ARG,
"maintain|m" => \$MAINTAIN_ARG,
"report|r" => \$REPORT_ARG,
"verbose|x" => \$VERBOSE,
"gettext-package|g=s" => \$GETTEXT_PACKAGE,
) or &print_error_invalid_option;
&print_help if $HELP_ARG;
&print_version if $VERSION_ARG;
my $arg_count = ($DIST_ARG > 0)
+ ($POT_ARG > 0)
+ ($HEADERS_ARG > 0)
+ ($MAINTAIN_ARG > 0)
+ ($REPORT_ARG > 0);
&print_help if $arg_count > 1;
# --version and --help don't require a module name
my $MODULE = $GETTEXT_PACKAGE || &find_package_name;
if ($DIST_ARG) {
if ($ARGV[0] =~ /^[a-z]/){
&update_po_file ($ARGV[0]);
&print_status ($ARGV[0]);
} else {
&print_help;
}
} elsif ($POT_ARG) {
&generate_headers;
&generate_po_template;
} elsif ($HEADERS_ARG) {
&generate_headers;
} elsif ($MAINTAIN_ARG) {
&find_leftout_files;
} elsif ($REPORT_ARG) {
&print_report;
} else {
if ($ARGV[0] =~ /^[a-z]/) {
&main ($ARGV[0]);
} else {
&print_help;
}
}
exit;
#########
sub print_version
{
## Print version information
print "${PROGRAM} (${PACKAGE}) $VERSION\n";
print "Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.\n\n";
print "Copyright (C) 2000-2002 Free Software Foundation, Inc.\n";
print "This is free software; see the source for copying conditions. There is NO\n";
print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
exit;
}
sub print_help
{
## Print usage information
print "Usage: ${PROGRAM} [OPTIONS] ...LANGCODE\n";
print "Updates PO template files and merge them with the translations.\n\n";
print " -p, --pot generate the PO template only\n";
print " -s, --headers generate the header files in POTFILES.in\n";
print " -m, --maintain search for left out files from POTFILES.in\n";
print " -r, --report display a status report for the module.\n";
print " -x, --verbose display lots of feedback\n";
print " --help display this help and exit\n";
print " --version output version information and exit\n";
print "\nExamples of use:\n";
print "${PROGRAM} --pot just creates a new PO template from the source\n";
print "${PROGRAM} da created new PO template and updated the da.po file\n\n";
print "Report bugs to bugzilla.gnome.org, module 'intltool'.\n";
exit;
}
sub main
{
my ($lang) = @_;
## Report error if the language file supplied
## to the command line is non-existent
&print_error_not_existing("$lang.po") if ! -s "$lang.po";
print "Working, please wait..." unless $VERBOSE;
&generate_headers;
&generate_po_template;
&update_po_file ($lang);
&print_status ($lang);
}
sub determine_type ($)
{
my $type = $_;
my $gettext_type;
# FIXME: Use $xml_extentions, and maybe do all this even nicer
my $xml_regex =
"(?:xml(\.in)*|ui|oaf(?:\.in)+|server(?:\.in)+|sheet(?:\.in)+|".
"pong(?:\.in)+|etspec)";
my $ini_regex =
"(?:desktop(?:\.in)+|caves(?:\.in)+|directory(?:\.in)+|".
"soundlist(?:\.in)+)";
if ($type =~ /\[type: gettext\/([^\]].*)]/) {
$gettext_type=$1;
}
elsif ($type =~ /$xml_regex$/) {
$gettext_type="xml";
}
elsif ($type =~ /glade2?(\.in)*$/) {
$gettext_type="glade";
}
elsif ($type =~ /$ini_regex$/) {
$gettext_type="ini";
}
elsif ($type =~ /scm(\.in)*$/) {
$gettext_type="scheme";
}
elsif ($type =~ /keys(\.in)+$/) {
$gettext_type="keys";
}
else { $gettext_type=""; }
return "gettext\/$gettext_type";
}
sub find_leftout_files
{
my (@buf_i18n_plain,
@buf_i18n_xml,
@buf_i18n_ini,
@buf_potfiles,
@buf_potfiles_ignore,
@buf_allfiles,
@buf_allfiles_sorted,
@buf_potfiles_sorted
);
## Search and find all translatable files
find sub {
push @buf_i18n_plain, "$File::Find::name" if /\.(c|y|cc|cpp|c\+\+|h|gob)$/
}, "..";
find sub {
push @buf_i18n_xml, "$File::Find::name" if /\.($xml_extension)$/
}, "..";
find sub {
push @buf_i18n_ini, "$File::Find::name" if /\.($ini_extension)$/
}, "..";
open POTFILES, "POTFILES.in" || die "$PROGRAM: there's no POTFILES.in!\n";
@buf_potfiles = grep /^[^#]/, <POTFILES>;
print "Searching for missing translatable files...\n" if $VERBOSE;
## Check if we should ignore some found files, when
## comparing with POTFILES.in
foreach my $ignore ("POTFILES.skip", "POTFILES.ignore") {
if (-s $ignore) {
open FILE, $ignore;
while (<FILE>) {
if (/^[^#]/){
push @buf_potfiles_ignore, $_;
}
}
print "Found $ignore: Ignoring files...\n" if $VERBOSE;
@buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
}
}
foreach my $file (@buf_i18n_plain)
{
my $in_comment = 0;
my $in_macro = 0;
open FILE, "<$file";
while (<FILE>)
{
# Handle continued multi-line comment.
if ($in_comment)
{
next unless s-.*\*/--;
$in_comment = 0;
}
# Handle continued macro.
if ($in_macro)
{
$in_macro = 0 unless /\\$/;
next;
}
# Handle start of macro (or any preprocessor directive).
if (/^\s*\#/)
{
$in_macro = 1 if /^([^\\]|\\.)*\\$/;
next;
}
# Handle comments and quoted text.
while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy
{
my $match = $1;
if ($match eq "/*")
{
if (!s-/\*.*?\*/--)
{
s-/\*.*--;
$in_comment = 1;
}
}
elsif ($match eq "//")
{
s-//.*--;
}
else # ' or "
{
if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-)
{
warn "mismatched quotes at line $. in $file\n";
s-$match.*--;
}
}
}
if (/_\(QUOTEDTEXT/)
{
## Remove the first 3 chars and add newline
push @buf_allfiles, unpack("x3 A*", $file) . "\n";
last;
}
}
close FILE;
}
foreach my $file (@buf_i18n_xml) {
open FILE, "<$file";
while (<FILE>) {
if (/\s_(.*)=\"/){
push @buf_allfiles, unpack("x3 A*", $file) . "\n";
last;
}
}
}
foreach my $file (@buf_i18n_ini){
open FILE, "<$file";
while (<FILE>) {
if (/_(.*)=/){
push @buf_allfiles, unpack("x3 A*", $file) . "\n";
last;
}
}
}
@buf_allfiles_sorted = sort (@buf_allfiles);
@buf_potfiles_sorted = sort (@buf_potfiles);
my %in2;
foreach (@buf_potfiles_sorted) {
$in2{$_} = 1;
}
my @result;
foreach (@buf_allfiles_sorted){
if (!exists($in2{$_})){
push @result, $_
}
}
## Save file with information about the files missing
## if any, and give information about this procedure.
if (@result) {
print "\n" if $VERBOSE;
open OUT, ">missing";
print OUT @result;
print "The following files contain translations and are currently not in use. Please\n";
print "consider adding these to the POTFILES.in file, located in the po/ directory.\n\n";
print @result, "\n";
print "If some of these files are left out on purpose then please add them to\n";
print "POTFILES.skip instead of POTFILES.in. A file 'missing' containing this list\n";
print "of left out files has been written in the current directory.\n";
}
## If there is nothing to complain about, notify the user
else {
print "\nAll files containing translations are present in POTFILES.in.\n";
}
}
sub print_error_invalid_option
{
## Handle invalid arguments
print "Try `${PROGRAM} --help' for more information.\n";
exit 1;
}
sub generate_headers
{
my $EXTRACT = `which intltool-extract 2>/dev/null`;
chomp $EXTRACT;
$EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
## Generate the .h header files, so we can allow glade and
## xml translation support
if (! -s $EXTRACT)
{
print "\n *** The intltool-extract script wasn't found!"
."\n *** Without it, intltool-update can not generate files.\n";
exit;
}
else
{
open FILE, "<POTFILES.in";
while (<FILE>) {
chomp;
## Find xml files in POTFILES.in and generate the
## files with help from the extract script
my $gettext_type= &determine_type ($1);
if (/\.($xml_extension|$ini_extension)$/ || /^\[/){
$_ =~ s/^\[[^\[].*]\s*//;
my $filename = "../$_";
my $srcdir = $ENV{'top_srcdir'};
if ($srcdir){
$filename="$srcdir/$_" ;
};
if ($VERBOSE){
system($EXTRACT, "--update", "--type=$gettext_type", $filename);
} else {
system($EXTRACT, "--update", "--type=$gettext_type", "--quiet", $filename);
}
}
}
close FILE;
}
}
sub generate_po_template
{
## Generate the potfiles from the POTFILES.in file
print "Building the $MODULE.pot...\n" if $VERBOSE;
move ("POTFILES.in", "POTFILES.in.old");
my $srcdir = $ENV{'top_srcdir'};
my $adddirectory = "--directory=." ;
if ($srcdir){
$adddirectory = "--directory=$srcdir";
}
open INFILE, "<POTFILES.in.old";
open OUTFILE, ">POTFILES.in";
while (<INFILE>) {
s/\.($xml_extension|$ini_extension)$/$&.h/;
s/^\[.*]\s*(.*)/$1.h/;
print OUTFILE $_;
}
close OUTFILE;
close INFILE;
system ("xgettext", "--default-domain\=$MODULE",
"--directory\=\.\.",
"$adddirectory" ,
"--add-comments",
"--keyword\=\_",
"--keyword\=N\_",
"--keyword\=U\_",
"--files-from\=\.\/POTFILES\.in");
if (!-e "$MODULE.po") {
print "WARNING: It seems that none of the files in POTFILES.in ".
"contain marked strings\n";
exit (1);
}
system ("rm", "-f", "$MODULE.pot");
move ("$MODULE.po", "$MODULE.pot") || die "$PROGRAM: couldn't move $MODULE.po to $MODULE.pot.\n";
print "Wrote $MODULE.pot\n" if $VERBOSE;
move ("POTFILES.in.old", "POTFILES.in");
print "Removing generated header (.h) files..." if $VERBOSE;
open FILE, "<POTFILES.in";
while (<FILE>)
{
chomp;
unlink "../$_.h" if /\.($xml_extension|$ini_extension)$/;
}
close FILE;
print "done\n" if $VERBOSE;
}
sub update_po_file
{
my ($lang) = @_;
print "Merging $lang.po with $MODULE.pot..." if $VERBOSE;
copy ("$lang.po", "$lang.po.old") || die "copy failed: $!";
# Perform merge, remove backup file and the "messages" trash file
# generated by gettext
system ("msgmerge", "$lang.po.old", "$MODULE.pot", "-o", "$lang.po");
unlink "$lang.po.old";
unlink "messages";
}
sub print_error_not_existing
{
my ($file) = @_;
## Report error if supplied language file is non-existing
print "$PROGRAM: $file does not exist!\n";
print "Try '$PROGRAM --help' for more information.\n";
exit;
}
sub gather_po_files
{
my @po_files = glob ("./*.po");
@languages = map (&po_file2lang, @po_files);
foreach my $lang (@languages) {
$po_files_by_lang{$lang} = shift (@po_files);
}
}
sub po_file2lang ($)
{
my $tmp = $_;
$tmp =~ s/^.*\/(.*)\.po$/$1/;
return $tmp;
}
sub print_status
{
my ($lang) = @_;
system ("msgfmt", "--statistics", "$lang.po");
print "\n";
}
sub print_report
{
&generate_headers;
&generate_po_template;
&gather_po_files;
foreach my $lang (@languages) {
print "$lang: ";
&update_po_file ($lang);
}
print "\n\n * Current translation support in $MODULE \n\n";
foreach my $lang (@languages){
print "$lang: ";
system ("msgfmt", "--statistics", "$lang.po");
}
}
sub find_package_name
{
my $base_dirname = getcwd();
$base_dirname =~ s@.*/@@;
my ($conf_in, $src_dir);
if ($base_dirname =~ /^po(-.+)?$/) {
if (-f "../configure.ac") {
$conf_in = "../configure.ac";
} else {
my $makefile_source;
local (*IN);
open IN, "<Makefile" || die "can't open Makefile: $!";
while (<IN>) {
if (/^top_srcdir[ \t]*=/) {
$src_dir = $_;
# print "${src_dir}\n";
$src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/;
# print "${src_dir}\n";
chomp $src_dir;
$conf_in = "$src_dir" . "/configure.ac" . "\n";
last;
}
}
$conf_in || die "Cannot find top_srcdir in Makefile."
}
my $conf_source; {
local (*IN);
local $/; # slurp mode
open (IN, "<$conf_in") || die "can't open $conf_in: $!";
$conf_source = <IN>;
}
my $name = "";
$name = $1 if $conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+)/m;
$name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=(\S+)/m;
if ($name =~ /^[\$](\S+)/) {
return $1 if $conf_source =~ /^\s*$1=(\S*)/m;
}
return $name if $name;
}
print "$PROGRAM: Unable to determine package name.\n" .
"Make sure to run this script inside the po directory.\n";
exit;
}
