Context Navigation

intltool-update.in @ 20891

Visit:

Revision 20891, 25.1 KB checked in by ghudson, 20 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r20890, which included commits to RCS files with non-trunk default branches.

Line
1	#!@INTLTOOL_PERL@ -w
2	# -- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 --
3
4	#
5	# The Intltool Message Updater
6	#
7	# Copyright (C) 2000-2003 Free Software Foundation.
8	#
9	# Intltool is free software; you can redistribute it and/or
10	# modify it under the terms of the GNU General Public License
11	# version 2 published by the Free Software Foundation.
12	#
13	# Intltool is distributed in the hope that it will be useful,
14	# but WITHOUT ANY WARRANTY; without even the implied warranty of
15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16	# General Public License for more details.
17	#
18	# You should have received a copy of the GNU General Public License
19	# along with this program; if not, write to the Free Software
20	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21	#
22	# As a special exception to the GNU General Public License, if you
23	# distribute this file as part of a program that contains a
24	# configuration script generated by Autoconf, you may include it under
25	# the same distribution terms that you use for the rest of that program.
26	#
27	# Authors: Kenneth Christiansen <kenneth@gnu.org>
28	# Maciej Stachowiak
29	# Darin Adler <darin@bentspoon.com>
30
31	## Release information
32	my $PROGRAM = "intltool-update";
33	my $VERSION = "0.31";
34	my $PACKAGE = "intltool";
35
36	## Loaded modules
37	use strict;
38	use Getopt::Long;
39	use Cwd;
40	use File::Copy;
41	use File::Find;
42
43	## Scalars used by the option stuff
44	my $HELP_ARG = 0;
45	my $VERSION_ARG = 0;
46	my $DIST_ARG = 0;
47	my $POT_ARG = 0;
48	my $HEADERS_ARG = 0;
49	my $MAINTAIN_ARG = 0;
50	my $REPORT_ARG = 0;
51	my $VERBOSE = 0;
52	my $GETTEXT_PACKAGE = "";
53	my $OUTPUT_FILE = "";
54
55	my @languages;
56	my %varhash = ();
57	my %po_files_by_lang = ();
58
59	# Regular expressions to categorize file types.
60	# FIXME: Please check if the following is correct
61
62	my $xml_support =
63	"xml(?:\\.in)*\|". # http://www.w3.org/XML/ (Note: .in is not required)
64	"ui\|". # Bonobo specific - User Interface desc. files
65	"lang\|". # ?
66	"glade2?(?:\\.in)*\|". # Glade specific - User Interface desc. files (Note: .in is not required)
67	"scm(?:\\.in)*\|". # ? (Note: .in is not required)
68	"oaf(?:\\.in)+\|". # DEPRECATED: Replaces by Bonobo .server files
69	"etspec\|". # ?
70	"server(?:\\.in)+\|". # Bonobo specific
71	"sheet(?:\\.in)+\|". # ?
72	"schemas(?:\\.in)+\|". # GConf specific
73	"pong(?:\\.in)+\|". # DEPRECATED: PONG is not used [by GNOME] any longer.
74	"kbd(?:\\.in)+"; # GOK specific.
75
76	my $ini_support =
77	"desktop(?:\\.in)+\|". # http://www.freedesktop.org/Standards/menu-spec
78	"caves(?:\\.in)+\|". # GNOME Games specific
79	"directory(?:\\.in)+\|". # http://www.freedesktop.org/Standards/menu-spec
80	"soundlist(?:\\.in)+\|". # GNOME specific
81	"keys(?:\\.in)+\|". # GNOME Mime database specific
82	"theme(?:\\.in)+"; # http://www.freedesktop.org/Standards/icon-theme-spec
83
84	my $buildin_gettext_support =
85	"c\|y\|cs\|cc\|cpp\|c\\+\\+\|h\|hh\|gob\|py";
86
87	## Always flush buffer when printing
88	$\| = 1;
89
90	## Sometimes the source tree will be rooted somewhere else.
91	my $SRCDIR = ".";
92	my $POTFILES_in;
93
94	$SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"};
95	$POTFILES_in = "<$SRCDIR/POTFILES.in";
96
97	## Handle options
98	GetOptions
99	(
100	"help" => \$HELP_ARG,
101	"version" => \$VERSION_ARG,
102	"dist\|d" => \$DIST_ARG,
103	"pot\|p" => \$POT_ARG,
104	"headers\|s" => \$HEADERS_ARG,
105	"maintain\|m" => \$MAINTAIN_ARG,
106	"report\|r" => \$REPORT_ARG,
107	"verbose\|x" => \$VERBOSE,
108	"gettext-package\|g=s" => \$GETTEXT_PACKAGE,
109	"output-file\|o=s" => \$OUTPUT_FILE,
110	) or &Console_WriteError_InvalidOption;
111
112	&Console_Write_IntltoolHelp if $HELP_ARG;
113	&Console_Write_IntltoolVersion if $VERSION_ARG;
114
115	my $arg_count = ($DIST_ARG > 0)
116	+ ($POT_ARG > 0)
117	+ ($HEADERS_ARG > 0)
118	+ ($MAINTAIN_ARG > 0)
119	+ ($REPORT_ARG > 0);
120
121	&Console_Write_IntltoolHelp if $arg_count > 1;
122
123	# --version and --help don't require a module name
124	my $MODULE = $GETTEXT_PACKAGE \|\| &FindPackageName;
125
126	if ($POT_ARG)
127	{
128	&GenerateHeaders;
129	&GeneratePOTemplate;
130	}
131	elsif ($HEADERS_ARG)
132	{
133	&GenerateHeaders;
134	}
135	elsif ($MAINTAIN_ARG)
136	{
137	&FindLeftoutFiles;
138	}
139	elsif ($REPORT_ARG)
140	{
141	&GenerateHeaders;
142	&GeneratePOTemplate;
143	&Console_Write_CoverageReport;
144	}
145	elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/)
146	{
147	my $lang = $ARGV[0];
148
149	## Report error if the language file supplied
150	## to the command line is non-existent
151	&Console_WriteError_NotExisting("$lang.po") if ! -s "$lang.po";
152
153	if (!$DIST_ARG)
154	{
155	print "Working, please wait..." if $VERBOSE;
156	&GenerateHeaders;
157	&GeneratePOTemplate;
158	}
159	&POFile_Update ($lang, $OUTPUT_FILE);
160	&Console_Write_TranslationStatus ($lang, $OUTPUT_FILE);
161	}
162	else
163	{
164	&Console_Write_IntltoolHelp;
165	}
166
167	exit;
168
169	#########
170
171	sub Console_Write_IntltoolVersion
172	{
173	print <<_EOF_;
174	${PROGRAM} (${PACKAGE}) $VERSION
175	Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler.
176
177	Copyright (C) 2000-2003 Free Software Foundation, Inc.
178	This is free software; see the source for copying conditions. There is NO
179	warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
180	_EOF_
181	exit;
182	}
183
184	sub Console_Write_IntltoolHelp
185	{
186	print <<_EOF_;
187	Usage: ${PROGRAM} [OPTION]... LANGCODE
188	Updates PO template files and merge them with the translations.
189
190	Mode of operation (only one is allowed):
191	-p, --pot generate the PO template only
192	-s, --headers generate the header files in POTFILES.in
193	-m, --maintain search for left out files from POTFILES.in
194	-r, --report display a status report for the module
195	-d, --dist merge LANGCODE.po with existing PO template
196
197	Extra options:
198	-g, --gettext-package=NAME override PO template name, useful with --pot
199	-o, --output-file=FILE write merged translation to FILE
200	-x, --verbose display lots of feedback
201	--help display this help and exit
202	--version output version information and exit
203
204	Examples of use:
205	${PROGRAM} --pot just create a new PO template
206	${PROGRAM} xy create new PO template and merge xy.po with it
207
208	Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
209	or send email to <xml-i18n-tools\@gnome.org>.
210	_EOF_
211	exit;
212	}
213
214	sub POFile_DetermineType ($)
215	{
216	my $type = $_;
217	my $gettext_type;
218
219	my $xml_regex = "(?:" . $xml_support . ")";
220	my $ini_regex = "(?:" . $ini_support . ")";
221	my $buildin_regex = "(?:" . $buildin_gettext_support . ")";
222
223	if ($type =~ /\[type: gettext\/([^\]].*)]/)
224	{
225	$gettext_type=$1;
226	}
227	elsif ($type =~ /schemas(\.in)+$/)
228	{
229	$gettext_type="schemas";
230	}
231	elsif ($type =~ /glade2?(\.in)*$/)
232	{
233	$gettext_type="glade";
234	}
235	elsif ($type =~ /scm(\.in)*$/)
236	{
237	$gettext_type="scheme";
238	}
239	elsif ($type =~ /keys(\.in)+$/)
240	{
241	$gettext_type="keys";
242	}
243
244	# bucket types
245
246	elsif ($type =~ /$xml_regex$/)
247	{
248	$gettext_type="xml";
249	}
250	elsif ($type =~ /$ini_regex$/)
251	{
252	$gettext_type="ini";
253	}
254	elsif ($type =~ /$buildin_regex$/)
255	{
256	$gettext_type="buildin";
257	}
258	else
259	{
260	$gettext_type="unknown";
261	}
262
263	return "gettext\/$gettext_type";
264	}
265
266	sub TextFile_DetermineEncoding ($)
267	{
268	my $gettext_code="ASCII"; # All files are ASCII by default
269	my $filetype=`file $_ \| cut -d ' ' -f 2`;
270
271	if ($? eq "0")
272	{
273	if ($filetype =~ /^(ISO\|UTF)/)
274	{
275	chomp ($gettext_code = $filetype);
276	}
277	elsif ($filetype =~ /^XML/)
278	{
279	$gettext_code="UTF-8"; # We asume that .glade and other .xml files are UTF-8
280	}
281	}
282
283	return $gettext_code;
284	}
285
286
287	sub FindLeftoutFiles
288	{
289	my (@buf_i18n_plain,
290	@buf_i18n_xml,
291	@buf_i18n_xml_unmarked,
292	@buf_i18n_ini,
293	@buf_potfiles,
294	@buf_potfiles_ignore,
295	@buf_allfiles,
296	@buf_allfiles_sorted,
297	@buf_potfiles_sorted
298	);
299
300	## Search and find all translatable files
301	find sub {
302	push @buf_i18n_plain, "$File::Find::name" if /\.($buildin_gettext_support)$/;
303	push @buf_i18n_xml, "$File::Find::name" if /\.($xml_support)$/;
304	push @buf_i18n_ini, "$File::Find::name" if /\.($ini_support)$/;
305	push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/;
306	}, "..";
307
308
309	open POTFILES, $POTFILES_in or die "$PROGRAM: there's no POTFILES.in!\n";
310	@buf_potfiles = grep !/^(#\|\s*$)/, <POTFILES>;
311	close POTFILES;
312
313	foreach (@buf_potfiles) {
314	s/^\[.]\s//;
315	}
316
317	print "Searching for missing translatable files...\n" if $VERBOSE;
318
319	## Check if we should ignore some found files, when
320	## comparing with POTFILES.in
321	foreach my $ignore ("POTFILES.skip", "POTFILES.ignore")
322	{
323	(-s $ignore) or next;
324
325	if ("$ignore" eq "POTFILES.ignore")
326	{
327	print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n".
328	"content of this file to POTFILES.skip.\n";
329	}
330
331	print "Found $ignore: Ignoring files...\n" if $VERBOSE;
332	open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n";
333
334	while (<FILE>)
335	{
336	push @buf_potfiles_ignore, $_ unless /^(#\|\s*$)/;
337	}
338	close FILE;
339
340	@buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles);
341	}
342
343	foreach my $file (@buf_i18n_plain)
344	{
345	my $in_comment = 0;
346	my $in_macro = 0;
347
348	open FILE, "<$file";
349	while (<FILE>)
350	{
351	# Handle continued multi-line comment.
352	if ($in_comment)
353	{
354	next unless s-.\/--;
355	$in_comment = 0;
356	}
357
358	# Handle continued macro.
359	if ($in_macro)
360	{
361	$in_macro = 0 unless /\\$/;
362	next;
363	}
364
365	# Handle start of macro (or any preprocessor directive).
366	if (/^\s*\#/)
367	{
368	$in_macro = 1 if /^([^\\]\|\\.)*\\$/;
369	next;
370	}
371
372	# Handle comments and quoted text.
373	while (m-(/\*\|//\|\'\|\")-) # \' and \" keep emacs perl mode happy
374	{
375	my $match = $1;
376	if ($match eq "/*")
377	{
378	if (!s-/\.?\*/--)
379	{
380	s-/\.--;
381	$in_comment = 1;
382	}
383	}
384	elsif ($match eq "//")
385	{
386	s-//.*--;
387	}
388	else # ' or "
389	{
390	if (!s-$match([^\\]\|\\.)*?$match-QUOTEDTEXT-)
391	{
392	warn "mismatched quotes at line $. in $file\n";
393	s-$match.*--;
394	}
395	}
396	}
397
398	if (/\.GetString ?\(QUOTEDTEXT/)
399	{
400	## Remove the first 3 chars and add newline
401	push @buf_allfiles, unpack("x3 A*", $file) . "\n";
402	last;
403	}
404
405	if (/_\(QUOTEDTEXT/)
406	{
407	## Remove the first 3 chars and add newline
408	push @buf_allfiles, unpack("x3 A*", $file) . "\n";
409	last;
410	}
411	}
412	close FILE;
413	}
414
415	foreach my $file (@buf_i18n_xml)
416	{
417	open FILE, "<$file";
418
419	while (<FILE>)
420	{
421	# FIXME: share the pattern matching code with intltool-extract
422	if (/\s_(.*)=\"/ \|\| /<_[^>]+>/ \|\| /translatable=\"yes\"/)
423	{
424	push @buf_allfiles, unpack("x3 A*", $file) . "\n";
425	last;
426	}
427	}
428	close FILE;
429	}
430
431	foreach my $file (@buf_i18n_ini)
432	{
433	open FILE, "<$file";
434	while (<FILE>)
435	{
436	if (/_(.*)=/)
437	{
438	push @buf_allfiles, unpack("x3 A*", $file) . "\n";
439	last;
440	}
441	}
442	close FILE;
443	}
444
445	foreach my $file (@buf_i18n_xml_unmarked)
446	{
447	push @buf_allfiles, unpack("x3 A*", $file) . "\n";
448	}
449
450
451	@buf_allfiles_sorted = sort (@buf_allfiles);
452	@buf_potfiles_sorted = sort (@buf_potfiles);
453
454	my %in2;
455	foreach (@buf_potfiles_sorted)
456	{
457	$in2{$_} = 1;
458	}
459
460	my @result;
461
462	foreach (@buf_allfiles_sorted)
463	{
464	if (!exists($in2{$_}))
465	{
466	push @result, $_
467	}
468	}
469
470	my @buf_potfiles_notexist;
471
472	foreach (@buf_potfiles_sorted)
473	{
474	chomp (my $dummy = $_);
475	if ("$dummy" ne "" and ! -f "../$dummy")
476	{
477	push @buf_potfiles_notexist, $_;
478	}
479	}
480
481	## Save file with information about the files missing
482	## if any, and give information about this procedure.
483	if (@result + @buf_potfiles_notexist > 0)
484	{
485	if (@result)
486	{
487	print "\n" if $VERBOSE;
488	unlink "missing";
489	open OUT, ">missing";
490	print OUT @result;
491	close OUT;
492	warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n".
493	"\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n";
494	print STDERR @result, "\n";
495	warn "If some of these files are left out on purpose then please add them to\n".
496	"POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n".
497	"of left out files has been written in the current directory.\n";
498	}
499	if (@buf_potfiles_notexist)
500	{
501	unlink "notexist";
502	open OUT, ">notexist";
503	print OUT @buf_potfiles_notexist;
504	close OUT;
505	warn "\n" if ($VERBOSE or @result);
506	warn "\e[1mThe following files do not exist anymore:\e[0m\n\n";
507	warn @buf_potfiles_notexist, "\n";
508	warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n".
509	"containing this list of absent files has been written in the current directory.\n";
510	}
511	}
512
513	## If there is nothing to complain about, notify the user
514	else {
515	print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE;
516	}
517	}
518
519	sub Console_WriteError_InvalidOption
520	{
521	## Handle invalid arguments
522	print STDERR "Try `${PROGRAM} --help' for more information.\n";
523	exit 1;
524	}
525
526	sub GenerateHeaders
527	{
528	my $EXTRACT = `which intltool-extract 2>/dev/null`;
529	chomp $EXTRACT;
530
531	$EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"};
532
533	## Generate the .h header files, so we can allow glade and
534	## xml translation support
535	if (! -x "$EXTRACT")
536	{
537	print STDERR "\n *** The intltool-extract script wasn't found!"
538	."\n *** Without it, intltool-update can not generate files.\n";
539	exit;
540	}
541	else
542	{
543	open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n";
544
545	while (<FILE>)
546	{
547	chomp;
548	next if /^\[\s*encoding/;
549
550	## Find xml files in POTFILES.in and generate the
551	## files with help from the extract script
552
553	my $gettext_type= &POFile_DetermineType ($1);
554
555	if (/\.($xml_support\|$ini_support)$/ \|\| /^\[/)
556	{
557	s/^\[[^\[].]\s//;
558
559	my $filename = "../$_";
560
561	if ($VERBOSE)
562	{
563	system ($EXTRACT, "--update", "--srcdir=$SRCDIR",
564	"--type=$gettext_type", $filename);
565	}
566	else
567	{
568	system ($EXTRACT, "--update", "--type=$gettext_type",
569	"--srcdir=$SRCDIR", "--quiet", $filename);
570	}
571	}
572	}
573	close FILE;
574	}
575	}
576
577	#
578	# Generate .pot file from POTFILES.in
579	#
580	sub GeneratePOTemplate
581	{
582	my $XGETTEXT = `which xgettext 2>/dev/null`;
583	my $XGETTEXT_ARGS = '';
584	chomp $XGETTEXT;
585
586	$XGETTEXT = $ENV{"XGETTEXT"} if $ENV{"XGETTEXT"};
587	$XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} if $ENV{"XGETTEXT_ARGS"};
588
589	if (! -x $XGETTEXT)
590	{
591	print STDERR " *** xgettext is not found on this system!\n".
592	" *** Without it, intltool-update can not extract strings.\n";
593	exit;
594	}
595
596	print "Building $MODULE.pot...\n" if $VERBOSE;
597
598	open INFILE, $POTFILES_in;
599	unlink "POTFILES.in.temp";
600	open OUTFILE, ">POTFILES.in.temp";
601
602	my $gettext_support_nonascii = 0;
603
604	# checks for GNU gettext >= 0.12
605	my $dummy = `$XGETTEXT --version --from-code=UTF-8 >/dev/null 2>/dev/null`;
606	if ($? == 0)
607	{
608	$gettext_support_nonascii = 1;
609	}
610	else
611	{
612	# urge everybody to upgrade gettext
613	print STDERR "WARNING: This version of gettext does not support extracting non-ASCII\n".
614	" strings. That means you should install a version of gettext\n".
615	" that supports non-ASCII strings (such as GNU gettext >= 0.12),\n".
616	" or have to let non-ASCII strings untranslated. (If there is any)\n";
617	}
618
619	my $encoding = "ASCII";
620	my $forced_gettext_code;
621	my @temp_headers;
622	my $encoding_problem_is_reported = 0;
623
624	while (<INFILE>)
625	{
626	next if (/^#/ or /^\s*$/);
627
628	chomp;
629
630	my $gettext_code;
631
632	if (/^\[\sencoding:\s(.)\s\]/)
633	{
634	$forced_gettext_code=$1;
635	}
636	elsif (/\.($xml_support\|$ini_support)$/ \|\| /^\[/)
637	{
638	s/^\[.]\s//;
639	print OUTFILE "$_.h\n";
640	push @temp_headers, "../$_.h";
641	$gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code);
642	}
643	else
644	{
645	if ($SRCDIR eq ".") {
646	print OUTFILE "$_\n";
647	} else {
648	print OUTFILE "$SRCDIR/../$_\n";
649	}
650	$gettext_code = &TextFile_DetermineEncoding ("../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code);
651	}
652
653	next if (! $gettext_support_nonascii);
654
655	if (defined $forced_gettext_code)
656	{
657	$encoding=$forced_gettext_code;
658	}
659	elsif (defined $gettext_code and "$encoding" ne "$gettext_code")
660	{
661	if ($encoding eq "ASCII")
662	{
663	$encoding=$gettext_code;
664	}
665	elsif ($gettext_code ne "ASCII")
666	{
667	# Only report once because the message is quite long
668	if (! $encoding_problem_is_reported)
669	{
670	print STDERR "WARNING: You should use the same file encoding for all your project files,\n".
671	" but $PROGRAM thinks that most of the source files are in\n".
672	" $encoding encoding, while \"$_\" is (likely) in\n".
673	" $gettext_code encoding. If you are sure that all translatable strings\n".
674	" are in same encoding (say UTF-8), please \e[1mprepend\e[0m the following\n".
675	" line to POTFILES.in:\n\n".
676	" [encoding: UTF-8]\n\n".
677	" and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n".
678	"(such warning message will only be reported once.)\n";
679	$encoding_problem_is_reported = 1;
680	}
681	}
682	}
683	}
684
685	close OUTFILE;
686	close INFILE;
687
688	unlink "$MODULE.pot";
689	my @xgettext_argument=("$XGETTEXT",
690	"--add-comments",
691	"--directory\=\.\.",
692	"--output\=$MODULE\.pot",
693	"--files-from\=\.\/POTFILES\.in\.temp");
694	my $XGETTEXT_KEYWORDS = &FindPOTKeywords;
695	push @xgettext_argument, $XGETTEXT_KEYWORDS;
696	push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii);
697	push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS;
698	my $xgettext_command = join ' ', @xgettext_argument;
699
700	# intercept xgettext error message
701	print "Running $xgettext_command\n" if $VERBOSE;
702	my $xgettext_error_msg = `$xgettext_command 2>\&1`;
703	my $command_failed = $?;
704
705	unlink "POTFILES.in.temp";
706
707	print "Removing generated header (.h) files..." if $VERBOSE;
708	unlink foreach (@temp_headers);
709	print "done.\n" if $VERBOSE;
710
711	if (! $command_failed)
712	{
713	if (! -e "$MODULE.pot")
714	{
715	print "None of the files in POTFILES.in contain strings marked for translation.\n" if $VERBOSE;
716	}
717	else
718	{
719	print "Wrote $MODULE.pot\n" if $VERBOSE;
720	}
721	}
722	else
723	{
724	if ($xgettext_error_msg =~ /--from-code/)
725	{
726	# replace non-ASCII error message with a more useful one.
727	print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n".
728	" string marked for translation. Please make sure that all strings marked\n".
729	" for translation are in uniform encoding (say UTF-8), then \e[1mprepend\e[0m the\n".
730	" following line to POTFILES.in and rerun $PROGRAM:\n\n".
731	" [encoding: UTF-8]\n\n";
732	}
733	else
734	{
735	print STDERR "$xgettext_error_msg";
736	if (-e "$MODULE.pot")
737	{
738	# is this possible?
739	print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n".
740	" Please consult error message above if there is any.\n";
741	}
742	else
743	{
744	print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n".
745	" error message above if there is any.\n";
746	}
747	}
748	exit (1);
749	}
750	}
751
752	sub POFile_Update
753	{
754	-f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n";
755
756	my ($lang, $outfile) = @_;
757
758	print "Merging $lang.po with $MODULE.pot..." if $VERBOSE;
759
760	my $infile = "$lang.po";
761	$outfile = "$lang.po" if ($outfile eq "");
762
763	# I think msgmerge won't overwrite old file if merge is not successful
764	system ("msgmerge", "-o", $outfile, $infile, "$MODULE.pot");
765	}
766
767	sub Console_WriteError_NotExisting
768	{
769	my ($file) = @_;
770
771	## Report error if supplied language file is non-existing
772	print STDERR "$PROGRAM: $file does not exist!\n";
773	print STDERR "Try '$PROGRAM --help' for more information.\n";
774	exit;
775	}
776
777	sub GatherPOFiles
778	{
779	my @po_files = glob ("./*.po");
780
781	@languages = map (&POFile_GetLanguage, @po_files);
782
783	foreach my $lang (@languages)
784	{
785	$po_files_by_lang{$lang} = shift (@po_files);
786	}
787	}
788
789	sub POFile_GetLanguage ($)
790	{
791	s/^(.*\/)?(.+)\.po$/$2/;
792	return $_;
793	}
794
795	sub Console_Write_TranslationStatus
796	{
797	my ($lang, $output_file) = @_;
798
799	$output_file = "$lang.po" if ($output_file eq "");
800
801	system ("msgfmt", "-o", "/dev/null", "--statistics", $output_file);
802	}
803
804	sub Console_Write_CoverageReport
805	{
806	&GatherPOFiles;
807
808	foreach my $lang (@languages)
809	{
810	print "$lang: ";
811	&POFile_Update ($lang, "");
812	}
813
814	print "\n\n * Current translation support in $MODULE \n\n";
815
816	foreach my $lang (@languages)
817	{
818	print "$lang: ";
819	system ("msgfmt", "-o", "/dev/null", "--statistics", "$lang.po");
820	}
821	}
822
823	sub SubstituteVariable
824	{
825	my ($str) = @_;
826
827	# always need to rewind file whenever it has been accessed
828	seek (CONF, 0, 0);
829
830	# cache each variable. varhash is global to we can add
831	# variables elsewhere.
832	while (<CONF>)
833	{
834	if (/^(\w+)=(.*)$/)
835	{
836	($varhash{$1} = $2) =~ s/^["'](.*)["']$/$1)/;
837	}
838	}
839
840	if ($str =~ /^(.)\${?([A-Z_]+)}?(.)$/)
841	{
842	my $rest = $3;
843	my $untouched = $1;
844	my $sub = $varhash{$2};
845
846	return SubstituteVariable ("$untouched$sub$rest");
847	}
848	return $str;
849	}
850
851	sub CONF_Handle_Open
852	{
853	my $base_dirname = getcwd();
854	$base_dirname =~ s@.*/@@;
855
856	my ($conf_in, $src_dir);
857
858	if ($base_dirname =~ /^po(-.+)?$/)
859	{
860	if (-f "Makevars")
861	{
862	my $makefile_source;
863
864	local (*IN);
865	open (IN, "<Makevars") \|\| die "can't open Makevars: $!";
866
867	while (<IN>)
868	{
869	if (/^top_builddir[ \t]*=/)
870	{
871	$src_dir = $_;
872	$src_dir =~ s/^top_builddir[ \t]=[ \t]([^ \t\n\r]*)/$1/;
873
874	chomp $src_dir;
875	if (-f "$src_dir" . "/configure.ac") {
876	$conf_in = "$src_dir" . "/configure.ac" . "\n";
877	} else {
878	$conf_in = "$src_dir" . "/configure.in" . "\n";
879	}
880	last;
881	}
882	}
883	close IN;
884
885	$conf_in \|\| die "Cannot find top_builddir in Makevars.";
886	}
887	elsif (-f "../configure.ac")
888	{
889	$conf_in = "../configure.ac";
890	}
891	elsif (-f "../configure.in")
892	{
893	$conf_in = "../configure.in";
894	}
895	else
896	{
897	my $makefile_source;
898
899	local (*IN);
900	open (IN, "<Makefile") \|\| return;
901
902	while (<IN>)
903	{
904	if (/^top_srcdir[ \t]*=/)
905	{
906	$src_dir = $_;
907	$src_dir =~ s/^top_srcdir[ \t]=[ \t]([^ \t\n\r]*)/$1/;
908
909	chomp $src_dir;
910	$conf_in = "$src_dir" . "/configure.in" . "\n";
911
912	last;
913	}
914	}
915	close IN;
916
917	$conf_in \|\| die "Cannot find top_srcdir in Makefile.";
918	}
919
920	open (CONF, "<$conf_in");
921	}
922	else
923	{
924	print STDERR "$PROGRAM: Unable to proceed.\n" .
925	"Make sure to run this script inside the po directory.\n";
926	exit;
927	}
928	}
929
930	sub FindPackageName
931	{
932	my $version;
933	my $domain = &FindMakevarsDomain;
934	my $name = $domain \|\| "untitled";
935
936	&CONF_Handle_Open;
937
938	my $conf_source; {
939	local (*IN);
940	open (IN, "<&CONF") \|\| return $name;
941	seek (IN, 0, 0);
942	local $/; # slurp mode
943	$conf_source = <IN>;
944	close IN;
945	}
946
947	# priority for getting package name:
948	# 1. GETTEXT_PACKAGE
949	# 2. first argument of AC_INIT (with >= 2 arguments)
950	# 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument)
951
952	# /^AM_INIT_AUTOMAKE$[\s\[]*([^,$\s\]]+)/m
953	# the \s makes this not work, why?
954	if ($conf_source =~ /^AM_INIT_AUTOMAKE$([^,$]+),([^,\)]+)/m)
955	{
956	($name, $version) = ($1, $2);
957	($varhash{"AC_PACKAGE_NAME"} = $name) =~ s/[\[\]\s]//g;
958	($varhash{"PACKAGE"} = $name) =~ s/[\[\]\s]//g;
959	($varhash{"AC_PACKAGE_VERSION"} = $version) =~ s/[\[\]\s]//g;
960	($varhash{"VERSION"} = $version) =~ s/[\[\]\s]//g;
961	}
962
963	if ($conf_source =~ /^AC_INIT$([^,$]+),([^,\)]+)/m)
964	{
965	($name, $version) = ($1, $2);
966	($varhash{"AC_PACKAGE_NAME"} = $name) =~ s/[\[\]\s]//g;
967	($varhash{"PACKAGE"} = $name) =~ s/[\[\]\s]//g;
968	($varhash{"AC_PACKAGE_VERSION"} = $version) =~ s/[\[\]\s]//g;
969	($varhash{"VERSION"} = $version) =~ s/[\[\]\s]//g;
970	}
971
972	# \s makes this not work, why?
973	$name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m;
974
975	# prepend '$' to auto* internal variables, usually they are
976	# used in configure.in/ac without the '$'
977	$name =~ s/AC_/\$AC_/g;
978	$name =~ s/\$\$/\$/g;
979
980	$name = $domain if $domain;
981
982	$name = SubstituteVariable ($name);
983	$name =~ s/^["'](.*)["']$/$1/;
984
985	return $name if $name;
986	}
987
988
989	sub FindPOTKeywords
990	{
991
992	my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_";
993	my $varname = "XGETTEXT_OPTIONS";
994	my $make_source; {
995	local (*IN);
996	open (IN, "<Makevars") \|\| (open(IN, "<Makefile.in.in") && ($varname = "XGETTEXT_KEYWORDS")) \|\| return $keywords;
997	seek (IN, 0, 0);
998	local $/; # slurp mode
999	$make_source = <IN>;
1000	close IN;
1001	}
1002
1003	$keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m;
1004
1005	return $keywords;
1006	}
1007
1008	sub FindMakevarsDomain
1009	{
1010
1011	my $domain = "";
1012	my $makevars_source; {
1013	local (*IN);
1014	open (IN, "<Makevars") \|\| return $domain;
1015	seek (IN, 0, 0);
1016	local $/; # slurp mode
1017	$makevars_source = <IN>;
1018	close IN;
1019	}
1020
1021	$domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]]+)/m;
1022	$domain =~ s/^\s+//;
1023	$domain =~ s/\s+$//;
1024
1025	return $domain;
1026	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format