2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*-
5 # The Intltool Message Merger
7 # Copyright (C) 2000, 2003 Free Software Foundation.
8 # Copyright (C) 2000, 2001 Eazel, Inc
10 # Intltool is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License
12 # version 2 published by the Free Software Foundation.
14 # Intltool is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 # As a special exception to the GNU General Public License, if you
24 # distribute this file as part of a program that contains a
25 # configuration script generated by Autoconf, you may include it under
26 # the same distribution terms that you use for the rest of that program.
28 # Authors: Maciej Stachowiak <mjs@noisehavoc.org>
29 # Kenneth Christiansen <kenneth@gnu.org>
30 # Darin Adler <darin@bentspoon.com>
32 # Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>
35 ## Release information
36 my $PROGRAM = "intltool-merge";
37 my $PACKAGE = "intltool";
38 my $VERSION = "0.37.1";
46 my $must_end_tag = -1;
48 my $translation_depth = -1;
51 my @translation_strings = ();
52 my $leading_space = "";
54 ## Scalars used by the option stuff
58 my $XML_STYLE_ARG = 0;
59 my $KEYS_STYLE_ARG = 0;
60 my $DESKTOP_STYLE_ARG = 0;
61 my $SCHEMAS_STYLE_ARG = 0;
62 my $RFC822DEB_STYLE_ARG = 0;
63 my $QUOTED_STYLE_ARG = 0;
64 my $QUOTEDXML_STYLE_ARG = 0;
66 my $PASS_THROUGH_ARG = 0;
68 my $MULTIPLE_OUTPUT = 0;
75 "version" => \$VERSION_ARG,
76 "quiet|q" => \$QUIET_ARG,
77 "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility
78 "ba-style|b" => \$BA_STYLE_ARG,
79 "xml-style|x" => \$XML_STYLE_ARG,
80 "keys-style|k" => \$KEYS_STYLE_ARG,
81 "desktop-style|d" => \$DESKTOP_STYLE_ARG,
82 "schemas-style|s" => \$SCHEMAS_STYLE_ARG,
83 "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
84 "quoted-style" => \$QUOTED_STYLE_ARG,
85 "quotedxml-style" => \$QUOTEDXML_STYLE_ARG,
86 "pass-through|p" => \$PASS_THROUGH_ARG,
87 "utf8|u" => \$UTF8_ARG,
88 "multiple-output|m" => \$MULTIPLE_OUTPUT,
89 "cache|c=s" => \$cache_file
96 my %po_files_by_lang = ();
97 my %translations = ();
98 my $iconv = $ENV{"ICONV"} || "iconv";
99 my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
104 # If either a file exists, or when run it returns 0 exit status
105 return 1 if ((-x $file) or (system("$file -l >$devnull") == 0));
109 if (! isProgramInPath ("$iconv"))
111 print STDERR " *** iconv is not found on this system!\n".
112 " *** Without it, intltool-merge can not convert encodings.\n";
116 # Use this instead of \w for XML files to handle more possible characters.
117 my $w = "[-A-Za-z0-9._:]";
119 # XML quoted string contents
122 ## Check for options.
132 elsif ($BA_STYLE_ARG && @ARGV > 2)
137 &ba_merge_translations;
140 elsif ($XML_STYLE_ARG && @ARGV > 2)
148 elsif ($KEYS_STYLE_ARG && @ARGV > 2)
153 &keys_merge_translations;
156 elsif ($DESKTOP_STYLE_ARG && @ARGV > 2)
161 &desktop_merge_translations;
164 elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2)
169 &schemas_merge_translations;
172 elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2)
176 &rfc822deb_merge_translations;
179 elsif (($QUOTED_STYLE_ARG || $QUOTEDXML_STYLE_ARG) && @ARGV > 2)
184 "ed_merge_translations($QUOTEDXML_STYLE_ARG);
194 ## Sub for printing release information
198 ${PROGRAM} (${PACKAGE}) ${VERSION}
199 Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.
201 Copyright (C) 2000-2003 Free Software Foundation, Inc.
202 Copyright (C) 2000-2001 Eazel, Inc.
203 This is free software; see the source for copying conditions. There is NO
204 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
209 ## Sub for printing usage information
213 Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE
214 Generates an output file that includes some localized attributes from an
215 untranslated source file.
217 Mandatory options: (exactly one must be specified)
218 -b, --ba-style includes translations in the bonobo-activation style
219 -d, --desktop-style includes translations in the desktop style
220 -k, --keys-style includes translations in the keys style
221 -s, --schemas-style includes translations in the schemas style
222 -r, --rfc822deb-style includes translations in the RFC822 style
223 --quoted-style includes translations in the quoted string style
224 --quotedxml-style includes translations in the quoted xml string style
225 -x, --xml-style includes translations in the standard xml style
228 -u, --utf8 convert all strings to UTF-8 before merging
229 (default for everything except RFC822 style)
230 -p, --pass-through deprecated, does nothing and issues a warning
231 -m, --multiple-output output one localized file per locale, instead of
232 a single file containing all localized elements
233 -c, --cache=FILE specify cache file name
234 (usually \$top_builddir/po/.intltool-merge-cache)
235 -q, --quiet suppress most messages
236 --help display this help and exit
237 --version output version information and exit
239 Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
240 or send email to <xml-i18n-tools\@gnome.org>.
246 ## Sub for printing error messages
249 print STDERR "Try `${PROGRAM} --help' for more information.\n";
256 print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
267 &get_translation_database;
270 # General-purpose code for looking up translations in .po files
275 $tmp =~ s/^.*\/(.*)\.po$/$1/;
281 if (my $linguas = $ENV{"LINGUAS"})
283 for my $lang (split / /, $linguas) {
284 my $po_file = $PO_DIR . "/" . $lang . ".po";
286 $po_files_by_lang{$lang} = $po_file;
292 if (open LINGUAS_FILE, "$PO_DIR/LINGUAS")
294 while (<LINGUAS_FILE>)
301 my $po_file = $PO_DIR . "/" . $lang . ".po";
303 $po_files_by_lang{$lang} = $po_file;
312 for my $po_file (glob "$PO_DIR/*.po") {
313 $po_files_by_lang{po_file2lang($po_file)} = $po_file;
319 sub get_local_charset
322 my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";
324 # seek character encoding aliases in charset.alias (glib)
326 if (open CHARSET_ALIAS, $alias_file)
328 while (<CHARSET_ALIAS>)
331 return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i)
337 # if not found, return input string
344 my ($in_po_file) = @_;
347 open IN_PO_FILE, $in_po_file or die;
350 ## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
351 if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/)
361 print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG;
362 $encoding = "ISO-8859-1";
365 system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
367 $encoding = get_local_charset($encoding);
373 sub utf8_sanity_check
375 print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
379 sub get_translation_database
382 &get_cached_translation_database;
384 &create_translation_database;
388 sub get_newest_po_age
392 foreach my $file (values %po_files_by_lang)
394 my $file_age = -M $file;
395 $newest_age = $file_age if !$newest_age || $file_age < $newest_age;
398 $newest_age = 0 if !$newest_age;
405 print "Generating and caching the translation database\n" unless $QUIET_ARG;
407 &create_translation_database;
409 open CACHE, ">$cache_file" || die;
410 print CACHE join "\x01", %translations;
416 print "Found cached translation database\n" unless $QUIET_ARG;
419 open CACHE, "<$cache_file" || die;
425 %translations = split "\x01", $contents;
428 sub get_cached_translation_database
430 my $cache_file_age = -M $cache_file;
431 if (defined $cache_file_age)
433 if ($cache_file_age <= &get_newest_po_age)
438 print "Found too-old cached translation database\n" unless $QUIET_ARG;
444 sub create_translation_database
446 for my $lang (keys %po_files_by_lang)
448 my $po_file = $po_files_by_lang{$lang};
452 my $encoding = get_po_encoding ($po_file);
454 if (lc $encoding eq "utf-8")
456 open PO_FILE, "<$po_file";
460 print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
462 open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";
467 open PO_FILE, "<$po_file";
478 $nextfuzzy = 1 if /^#, fuzzy/;
480 if (/^msgid "((\\.|[^\\]+)*)"/ )
482 $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
489 $msgid = unescape_po_string($1);
496 if (/^msgstr "((\\.|[^\\]+)*)"/)
498 $msgstr = unescape_po_string($1);
503 if (/^"((\\.|[^\\]+)*)"/)
505 $msgid .= unescape_po_string($1) if $inmsgid;
506 $msgstr .= unescape_po_string($1) if $inmsgstr;
509 $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
517 sub unescape_one_sequence
521 return "\\" if $sequence eq "\\\\";
522 return "\"" if $sequence eq "\\\"";
523 return "\n" if $sequence eq "\\n";
524 return "\r" if $sequence eq "\\r";
525 return "\t" if $sequence eq "\\t";
526 return "\b" if $sequence eq "\\b";
527 return "\f" if $sequence eq "\\f";
528 return "\a" if $sequence eq "\\a";
529 return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
531 return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
532 return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
534 # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
539 sub unescape_po_string
543 $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
561 # entity_encode: (string)
563 # Encode the given string to XML format (encode '<' etc).
567 my ($pre_encoded) = @_;
569 my @list_of_chars = unpack ('C*', $pre_encoded);
571 # with UTF-8 we only encode minimalistic
572 return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
575 sub entity_encode_int_minimalist
577 return """ if $_ == 34;
578 return "&" if $_ == 38;
579 return "'" if $_ == 39;
580 return "<" if $_ == 60;
581 return ">" if $_ == 62;
585 sub entity_encoded_translation
587 my ($lang, $string) = @_;
589 my $translation = $translations{$lang, $string};
590 return $string if !$translation;
591 return entity_encode ($translation);
594 ## XML (bonobo-activation specific) merge code
596 sub ba_merge_translations
601 local $/; # slurp mode
602 open INPUT, "<$FILE" or die "can't open $FILE: $!";
607 open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
608 # Binmode so that selftest works ok if using a native Win32 Perl...
609 binmode (OUTPUT) if $^O eq 'MSWin32';
611 while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s)
615 my $node = $2 . "\n";
619 while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {
620 push @strings, entity_decode($3);
625 for my $string (@strings)
627 for my $lang (keys %po_files_by_lang)
629 $langs{$lang} = 1 if $translations{$lang, $string};
633 for my $lang (sort keys %langs)
636 s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;
637 s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;
642 print OUTPUT $source;
648 ## XML (non-bonobo-activation) merge code
651 # Process tag attributes
652 # Only parameter is a HASH containing attributes -> values mapping
653 sub getAttributeString
656 my $do_translate = shift || 0;
657 my $language = shift || "";
659 my $translate = shift;
660 foreach my $e (reverse(sort(keys %{ $sub }))) {
662 my $string = $sub->{$e};
665 $string =~ s/^[\s]+//;
666 $string =~ s/[\s]+$//;
668 if ($string =~ /^'.*'$/)
672 $string =~ s/^['"]//g;
673 $string =~ s/['"]$//g;
675 if ($do_translate && $key =~ /^_/) {
679 my $decode_string = entity_decode($string);
680 my $translation = $translations{$language, $decode_string};
682 $translation = entity_encode($translation);
683 $string = $translation;
687 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
691 $result .= " $key=$quote$string$quote";
696 # Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
700 my $spacepreserve = shift || 0;
701 my @list = @{ $ref };
704 my $count = scalar(@list);
705 my $attrs = $list[0];
708 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
709 $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
711 while ($index < $count) {
712 my $type = $list[$index];
713 my $content = $list[$index+1];
717 # lets strip the whitespace here, and *ONLY* here
718 $content =~ s/\s+/ /gs if (!$spacepreserve);
721 } elsif ( "$type" ne "1" ) {
722 # We've got another element
724 $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
726 my $subresult = getXMLstring($content, $spacepreserve);
728 $result .= ">".$subresult . "</$type>";
741 # Translate list of nodes if necessary
742 sub translate_subnodes
746 my $language = shift || "";
747 my $singlelang = shift || 0;
748 my $spacepreserve = shift || 0;
750 my @nodes = @{ $content };
752 my $count = scalar(@nodes);
754 while ($index < $count) {
755 my $type = $nodes[$index];
756 my $rest = $nodes[$index+1];
758 my $oldMO = $MULTIPLE_OUTPUT;
759 $MULTIPLE_OUTPUT = 1;
760 traverse($fh, $type, $rest, $language, $spacepreserve);
761 $MULTIPLE_OUTPUT = $oldMO;
763 traverse($fh, $type, $rest, $language, $spacepreserve);
769 sub isWellFormedXmlFragment
771 my $ret = eval 'require XML::Parser';
773 die "You must have XML::Parser installed to run $0\n\n";
776 my $fragment = shift;
777 return 0 if (!$fragment);
779 $fragment = "<root>$fragment</root>";
780 my $xp = new XML::Parser(Style => 'Tree');
782 eval { $tree = $xp->parse($fragment); };
789 my $nodename = shift;
791 my $language = shift || "";
792 my $spacepreserve = shift || 0;
795 if ($content =~ /^[\s]*$/) {
796 $leading_space .= $content;
801 my @all = @{ $content };
802 my $attrs = shift @all;
804 my $outattr = getAttributeString($attrs, 1, $language, \$translate);
806 if ($nodename =~ /^_/) {
812 $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
813 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
815 print $fh "<$nodename", $outattr;
817 $lookup = getXMLstring($content, $spacepreserve);
818 if (!$spacepreserve) {
819 $lookup =~ s/^\s+//s;
820 $lookup =~ s/\s+$//s;
823 if ($lookup || $translate == 2) {
824 my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
825 if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
826 $translation = $lookup if (!$translation);
827 print $fh " xml:lang=\"", $language, "\"" if $language;
829 if ($translate == 2) {
830 translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
832 print $fh $translation;
834 print $fh "</$nodename>";
836 return; # this means there will be no same translation with xml:lang="$language"...
837 # if we want them both, just remove this "return"
840 if ($translate == 2) {
841 translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
845 print $fh "</$nodename>";
851 for my $lang (sort keys %po_files_by_lang) {
852 if ($MULTIPLE_OUTPUT && $lang ne "$language") {
859 my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
860 my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
861 if ($translate && !$translation) {
862 $translation = $lookup;
865 if ($translation || $translate) {
867 $leading_space =~ s/.*\n//g;
868 print $fh $leading_space;
869 print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
870 if ($translate == 2) {
871 translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
873 print $fh $translation;
875 print $fh "</$nodename>";
881 my $count = scalar(@all);
885 while ($index < $count) {
886 my $type = $all[$index];
887 my $rest = $all[$index+1];
888 traverse($fh, $type, $rest, $language, $spacepreserve);
891 print $fh "</$nodename>";
899 sub intltool_tree_comment
903 my $clist = $expat->{Curlist};
906 push @$clist, 1 => $data;
909 sub intltool_tree_cdatastart
912 my $clist = $expat->{Curlist};
915 push @$clist, 0 => $expat->original_string();
918 sub intltool_tree_cdataend
921 my $clist = $expat->{Curlist};
924 $clist->[$pos] .= $expat->original_string();
927 sub intltool_tree_char
931 my $clist = $expat->{Curlist};
934 # Use original_string so that we retain escaped entities
937 if ($pos > 0 and $clist->[$pos - 1] eq '0') {
938 $clist->[$pos] .= $expat->original_string();
940 push @$clist, 0 => $expat->original_string();
944 sub intltool_tree_start
950 # Use original_string so that we retain escaped entities
951 # in attribute values. We must convert the string to an
952 # @origlist array to conform to the structure of the Tree
955 my @original_array = split /\x/, $expat->original_string();
956 my $source = $expat->original_string();
958 # Remove leading tag.
960 $source =~ s|^\s*<\s*(\S+)||s;
962 # Grab attribute key/value pairs and push onto @origlist array.
966 if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
968 $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
970 push @origlist, '"' . $2 . '"';
972 elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
974 $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
976 push @origlist, "'" . $2 . "'";
984 my $ol = [ { @origlist } ];
986 push @{ $expat->{Lists} }, $expat->{Curlist};
987 push @{ $expat->{Curlist} }, $tag => $ol;
988 $expat->{Curlist} = $ol;
993 my $filename = shift || return;
995 die "ERROR Cannot find filename: $filename\n";
998 my $ret = eval 'require XML::Parser';
1000 die "You must have XML::Parser installed to run $0\n\n";
1002 my $xp = new XML::Parser(Style => 'Tree');
1003 $xp->setHandlers(Char => \&intltool_tree_char);
1004 $xp->setHandlers(Start => \&intltool_tree_start);
1005 $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
1006 $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
1007 my $tree = $xp->parsefile($filename);
1009 # <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
1011 # [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, [{},
1012 # 0, "Howdy", ref, [{}]], 0, "do" ] ]
1024 die "ERROR Cannot find filename: $infile\n";
1027 print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
1030 open DOCINPUT, "<${FILE}" or die;
1031 $source = <DOCINPUT>;
1034 if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
1038 elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
1048 my $language = shift || "";
1050 my $name = shift @{ $ref };
1051 my $cont = shift @{ $ref };
1053 while (!$name || "$name" eq "1") {
1054 $name = shift @{ $ref };
1055 $cont = shift @{ $ref };
1058 my $spacepreserve = 0;
1059 my $attrs = @{$cont}[0];
1060 $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
1062 traverse($fh, $name, $cont, $language, $spacepreserve);
1065 sub xml_merge_output
1069 if ($MULTIPLE_OUTPUT) {
1070 for my $lang (sort keys %po_files_by_lang) {
1072 mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1074 open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1075 binmode (OUTPUT) if $^O eq 'MSWin32';
1076 my $tree = readXml($FILE);
1077 print_header($FILE, \*OUTPUT);
1078 parseTree(\*OUTPUT, $tree, $lang);
1080 print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1083 mkdir "C" or -d "C" or die "Cannot create subdirectory C: $!\n";
1085 open OUTPUT, ">C/$OUTFILE" or die "Cannot open C/$OUTFILE: $!\n";
1086 binmode (OUTPUT) if $^O eq 'MSWin32';
1087 my $tree = readXml($FILE);
1088 print_header($FILE, \*OUTPUT);
1089 parseTree(\*OUTPUT, $tree);
1091 print "CREATED C/$OUTFILE\n" unless $QUIET_ARG;
1093 open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
1094 binmode (OUTPUT) if $^O eq 'MSWin32';
1095 my $tree = readXml($FILE);
1096 print_header($FILE, \*OUTPUT);
1097 parseTree(\*OUTPUT, $tree);
1099 print "CREATED $OUTFILE\n" unless $QUIET_ARG;
1103 sub keys_merge_translation
1107 if ( ! -d $lang && $MULTIPLE_OUTPUT)
1109 mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1112 open INPUT, "<${FILE}" or die "Cannot open ${FILE}: $!\n";
1113 open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1114 binmode (OUTPUT) if $^O eq 'MSWin32';
1118 if (s/^(\s*)_(\w+=(.*))/$1$2/)
1122 if (!$MULTIPLE_OUTPUT)
1126 my $non_translated_line = $_;
1128 for my $lang (sort keys %po_files_by_lang)
1130 my $translation = $translations{$lang, $string};
1131 next if !$translation;
1133 $_ = $non_translated_line;
1134 s/(\w+)=.*/[$lang]$1=$translation/;
1140 my $non_translated_line = $_;
1141 my $translation = $translations{$lang, $string};
1142 $translation = $string if !$translation;
1144 $_ = $non_translated_line;
1145 s/(\w+)=.*/$1=$translation/;
1158 print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1161 sub keys_merge_translations
1163 if ($MULTIPLE_OUTPUT)
1165 for my $lang (sort keys %po_files_by_lang)
1167 keys_merge_translation ($lang);
1169 keys_merge_translation ("C");
1173 keys_merge_translation (".");
1177 sub desktop_merge_translations
1179 open INPUT, "<${FILE}" or die;
1180 open OUTPUT, ">${OUTFILE}" or die;
1181 binmode (OUTPUT) if $^O eq 'MSWin32';
1185 if (s/^(\s*)_(\w+=(.*))/$1$2/)
1191 my $non_translated_line = $_;
1193 for my $lang (sort keys %po_files_by_lang)
1195 my $translation = $translations{$lang, $string};
1196 next if !$translation;
1198 $_ = $non_translated_line;
1199 s/(\w+)=.*/${1}[$lang]=$translation/;
1213 sub schemas_merge_translations
1218 local $/; # slurp mode
1219 open INPUT, "<$FILE" or die "can't open $FILE: $!";
1224 open OUTPUT, ">$OUTFILE" or die;
1225 binmode (OUTPUT) if $^O eq 'MSWin32';
1227 # FIXME: support attribute translations
1229 # Empty nodes never need translation, so unmark all of them.
1230 # For example, <_foo/> is just replaced by <foo/>.
1231 $source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
1233 while ($source =~ s/
1235 (\s+)(<locale\ name="C">(\s*)
1236 (<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
1237 (<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
1238 (<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*)
1244 my $locale_start_spaces = $2 ? $2 : '';
1245 my $default_spaces = $4 ? $4 : '';
1246 my $short_spaces = $7 ? $7 : '';
1247 my $long_spaces = $10 ? $10 : '';
1248 my $locale_end_spaces = $13 ? $13 : '';
1249 my $c_default_block = $3 ? $3 : '';
1250 my $default_string = $6 ? $6 : '';
1251 my $short_string = $9 ? $9 : '';
1252 my $long_string = $12 ? $12 : '';
1254 print OUTPUT "$locale_start_spaces$c_default_block";
1256 $default_string =~ s/\s+/ /g;
1257 $default_string = entity_decode($default_string);
1258 $short_string =~ s/\s+/ /g;
1259 $short_string = entity_decode($short_string);
1260 $long_string =~ s/\s+/ /g;
1261 $long_string = entity_decode($long_string);
1263 for my $lang (sort keys %po_files_by_lang)
1265 my $default_translation = $translations{$lang, $default_string};
1266 my $short_translation = $translations{$lang, $short_string};
1267 my $long_translation = $translations{$lang, $long_string};
1269 next if (!$default_translation && !$short_translation &&
1270 !$long_translation);
1272 print OUTPUT "\n$locale_start_spaces<locale name=\"$lang\">";
1274 print OUTPUT "$default_spaces";
1276 if ($default_translation)
1278 $default_translation = entity_encode($default_translation);
1279 print OUTPUT "<default>$default_translation</default>";
1282 print OUTPUT "$short_spaces";
1284 if ($short_translation)
1286 $short_translation = entity_encode($short_translation);
1287 print OUTPUT "<short>$short_translation</short>";
1290 print OUTPUT "$long_spaces";
1292 if ($long_translation)
1294 $long_translation = entity_encode($long_translation);
1295 print OUTPUT "<long>$long_translation</long>";
1298 print OUTPUT "$locale_end_spaces</locale>";
1302 print OUTPUT $source;
1307 sub rfc822deb_merge_translations
1310 for my $lang (keys %po_files_by_lang) {
1311 $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang}));
1316 $Text::Wrap::huge = 'overflow';
1317 $Text::Wrap::break = qr/\n|\s(?=\S)/;
1320 local $/; # slurp mode
1321 open INPUT, "<$FILE" or die "can't open $FILE: $!";
1326 open OUTPUT, ">${OUTFILE}" or die;
1327 binmode (OUTPUT) if $^O eq 'MSWin32';
1329 while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1332 my $non_translated_line = $3.$4;
1334 my $underscore = length($2);
1335 next if $underscore eq 0 && $non_translated_line =~ /^#/;
1336 # Remove [] dummy strings
1337 my $stripped = $string;
1338 $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2;
1339 $stripped =~ s/\[\s[^\[\]]*\]$//;
1340 $non_translated_line .= $stripped;
1342 print OUTPUT $sep.$non_translated_line;
1346 my @str_list = rfc822deb_split($underscore, $string);
1348 for my $lang (sort keys %po_files_by_lang)
1350 my $is_translated = 1;
1351 my $str_translated = '';
1354 for my $str (@str_list)
1356 my $translation = $translations{$lang, $str};
1364 # $translation may also contain [] dummy
1365 # strings, mostly to indicate an empty string
1366 $translation =~ s/\[\s[^\[\]]*\]$//;
1370 if ($underscore eq 2)
1372 $str_translated .= $translation;
1377 Text::Tabs::expand($translation) .
1383 if ($underscore eq 2)
1385 $str_translated .= ', ' . $translation;
1389 $str_translated .= Text::Tabs::expand(
1390 Text::Wrap::wrap(' ', ' ', $translation)) .
1396 # To fix some problems with Text::Wrap::wrap
1397 $str_translated =~ s/(\n )+\n/\n .\n/g;
1399 next unless $is_translated;
1401 $str_translated =~ s/\n \.\n$//;
1402 $str_translated =~ s/\s+$//;
1404 $_ = $non_translated_line;
1405 s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
1418 # Debian defines a special way to deal with rfc822-style files:
1419 # when a value contain newlines, it consists of
1420 # 1. a short form (first line)
1421 # 2. a long description, all lines begin with a space,
1422 # and paragraphs are separated by a single dot on a line
1423 # This routine returns an array of all paragraphs, and reformat
1425 # When first argument is 2, the string is a comma separated list of
1429 $text =~ s/^[ \t]//mg;
1430 return (split(/, */, $text, 0)) if $type ne 1;
1431 return ($text) if $text !~ /\n/;
1433 $text =~ s/([^\n]*)\n//;
1437 for my $line (split (/\n/, $text))
1440 if ($line =~ /^\.\s*$/)
1447 elsif ($line =~ /^\s/)
1449 # Line which must not be reformatted
1450 $str .= "\n" if length ($str) && $str !~ /\n$/;
1456 # Continuation line, remove newline
1457 $str .= " " if length ($str) && $str !~ /\n$/;
1463 push(@list, $str) if length ($str);
1468 sub quoted_translation
1470 my ($xml_mode, $lang, $string) = @_;
1472 $string = entity_decode($string) if $xml_mode;
1473 $string =~ s/\\\"/\"/g;
1475 my $translation = $translations{$lang, $string};
1476 $translation = $string if !$translation;
1477 $translation = entity_encode($translation) if $xml_mode;
1478 $translation =~ s/\"/\\\"/g;
1482 sub quoted_merge_translations
1484 my ($xml_mode) = @_;
1486 if (!$MULTIPLE_OUTPUT) {
1487 print "Quoted only supports Multiple Output.\n";
1491 for my $lang (sort keys %po_files_by_lang) {
1493 mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1495 open INPUT, "<${FILE}" or die;
1496 open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1497 binmode (OUTPUT) if $^O eq 'MSWin32';
1500 s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($xml_mode, $lang, $1) . "\""/ge;