home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 November / CPNL0711.ISO / communic / email / Evolution-2.8.2-2.msi / Data1.cab / intltool_merge < prev    next >
Text File  |  2007-03-07  |  36KB  |  1,404 lines
  1. #!/opt/perl/bin/perl -w
  2. # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
  3.  
  4. #
  5. #  The Intltool Message Merger
  6. #
  7. #  Copyright (C) 2000, 2003 Free Software Foundation.
  8. #  Copyright (C) 2000, 2001 Eazel, Inc
  9. #
  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.
  13. #
  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.
  18. #
  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.
  22. #
  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.
  27. #
  28. #  Authors:  Maciej Stachowiak <mjs@noisehavoc.org>
  29. #            Kenneth Christiansen <kenneth@gnu.org>
  30. #            Darin Adler <darin@bentspoon.com>
  31. #
  32. #  Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>
  33. #
  34.  
  35. ## Release information
  36. my $PROGRAM = "intltool-merge";
  37. my $PACKAGE = "intltool";
  38. my $VERSION = "0.35.5";
  39.  
  40. ## Loaded modules
  41. use strict; 
  42. use Getopt::Long;
  43. use Text::Wrap;
  44. use File::Basename;
  45.  
  46. my $must_end_tag      = -1;
  47. my $last_depth        = -1;
  48. my $translation_depth = -1;
  49. my @tag_stack = ();
  50. my @entered_tag = ();
  51. my @translation_strings = ();
  52. my $leading_space = "";
  53.  
  54. ## Scalars used by the option stuff
  55. my $HELP_ARG = 0;
  56. my $VERSION_ARG = 0;
  57. my $BA_STYLE_ARG = 0;
  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 $QUIET_ARG = 0;
  65. my $PASS_THROUGH_ARG = 0;
  66. my $UTF8_ARG = 0;
  67. my $MULTIPLE_OUTPUT = 0;
  68. my $cache_file;
  69.  
  70. ## Handle options
  71. GetOptions 
  72. (
  73.  "help" => \$HELP_ARG,
  74.  "version" => \$VERSION_ARG,
  75.  "quiet|q" => \$QUIET_ARG,
  76.  "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility
  77.  "ba-style|b" => \$BA_STYLE_ARG,
  78.  "xml-style|x" => \$XML_STYLE_ARG,
  79.  "keys-style|k" => \$KEYS_STYLE_ARG,
  80.  "desktop-style|d" => \$DESKTOP_STYLE_ARG,
  81.  "schemas-style|s" => \$SCHEMAS_STYLE_ARG,
  82.  "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
  83.  "quoted-style" => \$QUOTED_STYLE_ARG,
  84.  "pass-through|p" => \$PASS_THROUGH_ARG,
  85.  "utf8|u" => \$UTF8_ARG,
  86.  "multiple-output|m" => \$MULTIPLE_OUTPUT,
  87.  "cache|c=s" => \$cache_file
  88.  ) or &error;
  89.  
  90. my $PO_DIR;
  91. my $FILE;
  92. my $OUTFILE;
  93.  
  94. my %po_files_by_lang = ();
  95. my %translations = ();
  96. my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/opt/gnu/bin/iconv";
  97. my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
  98.  
  99. # Use this instead of \w for XML files to handle more possible characters.
  100. my $w = "[-A-Za-z0-9._:]";
  101.  
  102. # XML quoted string contents
  103. my $q = "[^\\\"]*";
  104.  
  105. ## Check for options. 
  106.  
  107. if ($VERSION_ARG) 
  108. {
  109.     &print_version;
  110. } 
  111. elsif ($HELP_ARG) 
  112. {
  113.     &print_help;
  114. } 
  115. elsif ($BA_STYLE_ARG && @ARGV > 2) 
  116. {
  117.     &utf8_sanity_check;
  118.     &preparation;
  119.     &print_message;
  120.     &ba_merge_translations;
  121.     &finalize;
  122. } 
  123. elsif ($XML_STYLE_ARG && @ARGV > 2) 
  124. {
  125.     &utf8_sanity_check;
  126.     &preparation;
  127.     &print_message;
  128.     &xml_merge_output;
  129.     &finalize;
  130. } 
  131. elsif ($KEYS_STYLE_ARG && @ARGV > 2) 
  132. {
  133.     &utf8_sanity_check;
  134.     &preparation;
  135.     &print_message;
  136.     &keys_merge_translations;
  137.     &finalize;
  138. } 
  139. elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) 
  140. {
  141.     &utf8_sanity_check;
  142.     &preparation;
  143.     &print_message;
  144.     &desktop_merge_translations;
  145.     &finalize;
  146. } 
  147. elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) 
  148. {
  149.     &utf8_sanity_check;
  150.     &preparation;
  151.     &print_message;
  152.     &schemas_merge_translations;
  153.     &finalize;
  154. } 
  155. elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) 
  156. {
  157.     &preparation;
  158.     &print_message;
  159.     &rfc822deb_merge_translations;
  160.     &finalize;
  161. } 
  162. elsif ($QUOTED_STYLE_ARG && @ARGV > 2) 
  163. {
  164.     &utf8_sanity_check;
  165.     &preparation;
  166.     &print_message;
  167.     "ed_merge_translations;
  168.     &finalize;
  169. } 
  170. else 
  171. {
  172.     &print_help;
  173. }
  174.  
  175. exit;
  176.  
  177. ## Sub for printing release information
  178. sub print_version
  179. {
  180.     print <<_EOF_;
  181. ${PROGRAM} (${PACKAGE}) ${VERSION}
  182. Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.
  183.  
  184. Copyright (C) 2000-2003 Free Software Foundation, Inc.
  185. Copyright (C) 2000-2001 Eazel, Inc.
  186. This is free software; see the source for copying conditions.  There is NO
  187. warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  188. _EOF_
  189.     exit;
  190. }
  191.  
  192. ## Sub for printing usage information
  193. sub print_help
  194. {
  195.     print <<_EOF_;
  196. Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE
  197. Generates an output file that includes some localized attributes from an
  198. untranslated source file.
  199.  
  200. Mandatory options: (exactly one must be specified)
  201.   -b, --ba-style         includes translations in the bonobo-activation style
  202.   -d, --desktop-style    includes translations in the desktop style
  203.   -k, --keys-style       includes translations in the keys style
  204.   -s, --schemas-style    includes translations in the schemas style
  205.   -r, --rfc822deb-style  includes translations in the RFC822 style
  206.       --quoted-style     includes translations in the quoted string style
  207.   -x, --xml-style        includes translations in the standard xml style
  208.  
  209. Other options:
  210.   -u, --utf8             convert all strings to UTF-8 before merging 
  211.                          (default for everything except RFC822 style)
  212.   -p, --pass-through     deprecated, does nothing and issues a warning
  213.   -m, --multiple-output  output one localized file per locale, instead of 
  214.                      a single file containing all localized elements
  215.   -c, --cache=FILE       specify cache file name
  216.                          (usually \$top_builddir/po/.intltool-merge-cache)
  217.   -q, --quiet            suppress most messages
  218.       --help             display this help and exit
  219.       --version          output version information and exit
  220.  
  221. Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
  222. or send email to <xml-i18n-tools\@gnome.org>.
  223. _EOF_
  224.     exit;
  225. }
  226.  
  227.  
  228. ## Sub for printing error messages
  229. sub print_error
  230. {
  231.     print STDERR "Try `${PROGRAM} --help' for more information.\n";
  232.     exit;
  233. }
  234.  
  235.  
  236. sub print_message 
  237. {
  238.     print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
  239. }
  240.  
  241.  
  242. sub preparation 
  243. {
  244.     $PO_DIR = $ARGV[0];
  245.     $FILE = $ARGV[1];
  246.     $OUTFILE = $ARGV[2];
  247.  
  248.     &gather_po_files;
  249.     &get_translation_database;
  250. }
  251.  
  252. # General-purpose code for looking up translations in .po files
  253.  
  254. sub po_file2lang
  255. {
  256.     my ($tmp) = @_; 
  257.     $tmp =~ s/^.*\/(.*)\.po$/$1/; 
  258.     return $tmp; 
  259. }
  260.  
  261. sub gather_po_files
  262. {
  263.     for my $po_file (glob "$PO_DIR/*.po") {
  264.     $po_files_by_lang{po_file2lang($po_file)} = $po_file;
  265.     }
  266. }
  267.  
  268. sub get_local_charset
  269. {
  270.     my ($encoding) = @_;
  271.     my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "c:/devel/target/e65da0246693524f8ac3dc4a68739fef/lib/charset.alias";
  272.  
  273.     # seek character encoding aliases in charset.alias (glib)
  274.  
  275.     if (open CHARSET_ALIAS, $alias_file) 
  276.     {
  277.     while (<CHARSET_ALIAS>) 
  278.         {
  279.             next if /^\#/;
  280.             return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i)
  281.         }
  282.  
  283.         close CHARSET_ALIAS;
  284.     }
  285.  
  286.     # if not found, return input string
  287.  
  288.     return $encoding;
  289. }
  290.  
  291. sub get_po_encoding
  292. {
  293.     my ($in_po_file) = @_;
  294.     my $encoding = "";
  295.  
  296.     open IN_PO_FILE, $in_po_file or die;
  297.     while (<IN_PO_FILE>) 
  298.     {
  299.         ## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
  300.         if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) 
  301.         {
  302.             $encoding = $1; 
  303.             last;
  304.         }
  305.     }
  306.     close IN_PO_FILE;
  307.  
  308.     if (!$encoding) 
  309.     {
  310.         print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG;
  311.         $encoding = "ISO-8859-1";
  312.     }
  313.  
  314.     system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
  315.     if ($?) {
  316.     $encoding = get_local_charset($encoding);
  317.     }
  318.  
  319.     return $encoding
  320. }
  321.  
  322. sub utf8_sanity_check 
  323. {
  324.     print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
  325.     $UTF8_ARG = 1;
  326. }
  327.  
  328. sub get_translation_database
  329. {
  330.     if ($cache_file) {
  331.     &get_cached_translation_database;
  332.     } else {
  333.         &create_translation_database;
  334.     }
  335. }
  336.  
  337. sub get_newest_po_age
  338. {
  339.     my $newest_age;
  340.  
  341.     foreach my $file (values %po_files_by_lang) 
  342.     {
  343.     my $file_age = -M $file;
  344.     $newest_age = $file_age if !$newest_age || $file_age < $newest_age;
  345.     }
  346.  
  347.     $newest_age = 0 if !$newest_age;
  348.  
  349.     return $newest_age;
  350. }
  351.  
  352. sub create_cache
  353. {
  354.     print "Generating and caching the translation database\n" unless $QUIET_ARG;
  355.  
  356.     &create_translation_database;
  357.  
  358.     open CACHE, ">$cache_file" || die;
  359.     print CACHE join "\x01", %translations;
  360.     close CACHE;
  361. }
  362.  
  363. sub load_cache 
  364. {
  365.     print "Found cached translation database\n" unless $QUIET_ARG;
  366.  
  367.     my $contents;
  368.     open CACHE, "<$cache_file" || die;
  369.     {
  370.         local $/;
  371.         $contents = <CACHE>;
  372.     }
  373.     close CACHE;
  374.     %translations = split "\x01", $contents;
  375. }
  376.  
  377. sub get_cached_translation_database
  378. {
  379.     my $cache_file_age = -M $cache_file;
  380.     if (defined $cache_file_age) 
  381.     {
  382.         if ($cache_file_age <= &get_newest_po_age) 
  383.         {
  384.             &load_cache;
  385.             return;
  386.         }
  387.         print "Found too-old cached translation database\n" unless $QUIET_ARG;
  388.     }
  389.  
  390.     &create_cache;
  391. }
  392.  
  393. sub create_translation_database
  394. {
  395.     for my $lang (keys %po_files_by_lang) 
  396.     {
  397.         my $po_file = $po_files_by_lang{$lang};
  398.  
  399.         if ($UTF8_ARG) 
  400.         {
  401.             my $encoding = get_po_encoding ($po_file);
  402.  
  403.             if (lc $encoding eq "utf-8") 
  404.             {
  405.                 open PO_FILE, "<$po_file";    
  406.             } 
  407.             else 
  408.             {
  409.         print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
  410.  
  411.                 open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|";    
  412.             }
  413.         } 
  414.         else 
  415.         {
  416.             open PO_FILE, "<$po_file";    
  417.         }
  418.  
  419.     my $nextfuzzy = 0;
  420.     my $inmsgid = 0;
  421.     my $inmsgstr = 0;
  422.     my $msgid = "";
  423.     my $msgstr = "";
  424.  
  425.         while (<PO_FILE>) 
  426.         {
  427.         $nextfuzzy = 1 if /^#, fuzzy/;
  428.        
  429.         if (/^msgid "((\\.|[^\\]+)*)"/ ) 
  430.             {
  431.         $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
  432.         $msgid = "";
  433.         $msgstr = "";
  434.  
  435.         if ($nextfuzzy) {
  436.             $inmsgid = 0;
  437.         } else {
  438.             $msgid = unescape_po_string($1);
  439.             $inmsgid = 1;
  440.         }
  441.         $inmsgstr = 0;
  442.         $nextfuzzy = 0;
  443.         }
  444.  
  445.         if (/^msgstr "((\\.|[^\\]+)*)"/) 
  446.             {
  447.             $msgstr = unescape_po_string($1);
  448.         $inmsgstr = 1;
  449.         $inmsgid = 0;
  450.         }
  451.  
  452.         if (/^"((\\.|[^\\]+)*)"/) 
  453.             {
  454.             $msgid .= unescape_po_string($1) if $inmsgid;
  455.             $msgstr .= unescape_po_string($1) if $inmsgstr;
  456.         }
  457.     }
  458.     $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
  459.     }
  460. }
  461.  
  462. sub finalize
  463. {
  464. }
  465.  
  466. sub unescape_one_sequence
  467. {
  468.     my ($sequence) = @_;
  469.  
  470.     return "\\" if $sequence eq "\\\\";
  471.     return "\"" if $sequence eq "\\\"";
  472.     return "\n" if $sequence eq "\\n";
  473.     return "\r" if $sequence eq "\\r";
  474.     return "\t" if $sequence eq "\\t";
  475.     return "\b" if $sequence eq "\\b";
  476.     return "\f" if $sequence eq "\\f";
  477.     return "\a" if $sequence eq "\\a";
  478.     return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
  479.  
  480.     return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
  481.     return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
  482.  
  483.     # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
  484.  
  485.     return $sequence;
  486. }
  487.  
  488. sub unescape_po_string
  489. {
  490.     my ($string) = @_;
  491.  
  492.     $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
  493.  
  494.     return $string;
  495. }
  496.  
  497. ## NOTE: deal with < - < but not > - >  because it seems its ok to have 
  498. ## > in the entity. For further info please look at #84738.
  499. sub entity_decode
  500. {
  501.     local ($_) = @_;
  502.  
  503.     s/'/'/g; # '
  504.     s/"/"/g; # "
  505.     s/&/&/g;
  506.     s/</</g;
  507.  
  508.     return $_;
  509. }
  510.  
  511. # entity_encode: (string)
  512. #
  513. # Encode the given string to XML format (encode '<' etc).
  514.  
  515. sub entity_encode
  516. {
  517.     my ($pre_encoded) = @_;
  518.  
  519.     my @list_of_chars = unpack ('C*', $pre_encoded);
  520.  
  521.     # with UTF-8 we only encode minimalistic
  522.     return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
  523. }
  524.  
  525. sub entity_encode_int_minimalist
  526. {
  527.     return """ if $_ == 34;
  528.     return "&" if $_ == 38;
  529.     return "'" if $_ == 39;
  530.     return "<" if $_ == 60;
  531.     return chr $_;
  532. }
  533.  
  534. sub entity_encoded_translation
  535. {
  536.     my ($lang, $string) = @_;
  537.  
  538.     my $translation = $translations{$lang, $string};
  539.     return $string if !$translation;
  540.     return entity_encode ($translation);
  541. }
  542.  
  543. ## XML (bonobo-activation specific) merge code
  544.  
  545. sub ba_merge_translations
  546. {
  547.     my $source;
  548.  
  549.     {
  550.        local $/; # slurp mode
  551.        open INPUT, "<$FILE" or die "can't open $FILE: $!";
  552.        $source = <INPUT>;
  553.        close INPUT;
  554.     }
  555.  
  556.     open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
  557.     # Binmode so that selftest works ok if using a native Win32 Perl...
  558.     binmode (OUTPUT) if $^O eq 'MSWin32';
  559.  
  560.     while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
  561.     {
  562.         print OUTPUT $1;
  563.  
  564.         my $node = $2 . "\n";
  565.  
  566.         my @strings = ();
  567.         $_ = $node;
  568.     while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {
  569.              push @strings, entity_decode($3);
  570.         }
  571.     print OUTPUT;
  572.  
  573.     my %langs;
  574.     for my $string (@strings) 
  575.         {
  576.         for my $lang (keys %po_files_by_lang) 
  577.             {
  578.                 $langs{$lang} = 1 if $translations{$lang, $string};
  579.         }
  580.     }
  581.     
  582.     for my $lang (sort keys %langs) 
  583.         {
  584.         $_ = $node;
  585.         s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;
  586.         s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;
  587.         print OUTPUT;
  588.         }
  589.     }
  590.  
  591.     print OUTPUT $source;
  592.  
  593.     close OUTPUT;
  594. }
  595.  
  596.  
  597. ## XML (non-bonobo-activation) merge code
  598.  
  599.  
  600. # Process tag attributes
  601. #   Only parameter is a HASH containing attributes -> values mapping
  602. sub getAttributeString
  603. {
  604.     my $sub = shift;
  605.     my $do_translate = shift || 0;
  606.     my $language = shift || "";
  607.     my $result = "";
  608.     my $translate = shift;
  609.     foreach my $e (reverse(sort(keys %{ $sub }))) {
  610.     my $key    = $e;
  611.     my $string = $sub->{$e};
  612.     my $quote = '"';
  613.     
  614.     $string =~ s/^[\s]+//;
  615.     $string =~ s/[\s]+$//;
  616.     
  617.     if ($string =~ /^'.*'$/)
  618.     {
  619.         $quote = "'";
  620.     }
  621.     $string =~ s/^['"]//g;
  622.     $string =~ s/['"]$//g;
  623.  
  624.     if ($do_translate && $key =~ /^_/) {
  625.         $key =~ s|^_||g;
  626.         if ($language) {
  627.         # Handle translation
  628.         my $decode_string = entity_decode($string);
  629.         my $translation = $translations{$language, $decode_string};
  630.         if ($translation) {
  631.             $translation = entity_encode($translation);
  632.             $string = $translation;
  633.                 }
  634.                 $$translate = 2;
  635.             } else {
  636.                  $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
  637.             }
  638.     }
  639.     
  640.     $result .= " $key=$quote$string$quote";
  641.     }
  642.     return $result;
  643. }
  644.  
  645. # Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
  646. sub getXMLstring
  647. {
  648.     my $ref = shift;
  649.     my $spacepreserve = shift || 0;
  650.     my @list = @{ $ref };
  651.     my $result = "";
  652.  
  653.     my $count = scalar(@list);
  654.     my $attrs = $list[0];
  655.     my $index = 1;
  656.  
  657.     $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
  658.     $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
  659.  
  660.     while ($index < $count) {
  661.     my $type = $list[$index];
  662.     my $content = $list[$index+1];
  663.         if (! $type ) {
  664.         # We've got CDATA
  665.         if ($content) {
  666.         # lets strip the whitespace here, and *ONLY* here
  667.                 $content =~ s/\s+/ /gs if (!$spacepreserve);
  668.         $result .= $content;
  669.         }
  670.     } elsif ( "$type" ne "1" ) {
  671.         # We've got another element
  672.         $result .= "<$type";
  673.         $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
  674.         if ($content) {
  675.         my $subresult = getXMLstring($content, $spacepreserve);
  676.         if ($subresult) {
  677.             $result .= ">".$subresult . "</$type>";
  678.         } else {
  679.             $result .= "/>";
  680.         }
  681.         } else {
  682.         $result .= "/>";
  683.         }
  684.     }
  685.     $index += 2;
  686.     }
  687.     return $result;
  688. }
  689.  
  690. # Translate list of nodes if necessary
  691. sub translate_subnodes
  692. {
  693.     my $fh = shift;
  694.     my $content = shift;
  695.     my $language = shift || "";
  696.     my $singlelang = shift || 0;
  697.     my $spacepreserve = shift || 0;
  698.  
  699.     my @nodes = @{ $content };
  700.  
  701.     my $count = scalar(@nodes);
  702.     my $index = 0;
  703.     while ($index < $count) {
  704.         my $type = $nodes[$index];
  705.         my $rest = $nodes[$index+1];
  706.         if ($singlelang) {
  707.             my $oldMO = $MULTIPLE_OUTPUT;
  708.             $MULTIPLE_OUTPUT = 1;
  709.             traverse($fh, $type, $rest, $language, $spacepreserve);
  710.             $MULTIPLE_OUTPUT = $oldMO;
  711.         } else {
  712.             traverse($fh, $type, $rest, $language, $spacepreserve);
  713.         }
  714.         $index += 2;
  715.     }
  716. }
  717.  
  718. sub isWellFormedXmlFragment
  719. {
  720.     my $ret = eval 'require XML::Parser';
  721.     if(!$ret) {
  722.         die "You must have XML::Parser installed to run $0\n\n";
  723.     } 
  724.  
  725.     my $fragment = shift;
  726.     return 0 if (!$fragment);
  727.  
  728.     $fragment = "<root>$fragment</root>";
  729.     my $xp = new XML::Parser(Style => 'Tree');
  730.     my $tree = 0;
  731.     eval { $tree = $xp->parse($fragment); };
  732.     return $tree;
  733. }
  734.  
  735. sub traverse
  736. {
  737.     my $fh = shift; 
  738.     my $nodename = shift;
  739.     my $content = shift;
  740.     my $language = shift || "";
  741.     my $spacepreserve = shift || 0;
  742.  
  743.     if (!$nodename) {
  744.     if ($content =~ /^[\s]*$/) {
  745.         $leading_space .= $content;
  746.     }
  747.     print $fh $content;
  748.     } else {
  749.     # element
  750.     my @all = @{ $content };
  751.     my $attrs = shift @all;
  752.     my $translate = 0;
  753.     my $outattr = getAttributeString($attrs, 1, $language, \$translate);
  754.  
  755.     if ($nodename =~ /^_/) {
  756.         $translate = 1;
  757.         $nodename =~ s/^_//;
  758.     }
  759.     my $lookup = '';
  760.  
  761.         $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
  762.         $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
  763.  
  764.     print $fh "<$nodename", $outattr;
  765.     if ($translate) {
  766.         $lookup = getXMLstring($content, $spacepreserve);
  767.             if (!$spacepreserve) {
  768.                 $lookup =~ s/^\s+//s;
  769.                 $lookup =~ s/\s+$//s;
  770.             }
  771.  
  772.         if ($lookup || $translate == 2) {
  773.                 my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
  774.                 if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
  775.                     $translation = $lookup if (!$translation);
  776.                     print $fh " xml:lang=\"", $language, "\"" if $language;
  777.                     print $fh ">";
  778.                     if ($translate == 2) {
  779.                         translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
  780.                     } else {
  781.                         print $fh $translation;
  782.                     }
  783.                     print $fh "</$nodename>";
  784.  
  785.                     return; # this means there will be no same translation with xml:lang="$language"...
  786.                             # if we want them both, just remove this "return"
  787.                 } else {
  788.                     print $fh ">";
  789.                     if ($translate == 2) {
  790.                         translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
  791.                     } else {
  792.                         print $fh $lookup;
  793.                     }
  794.                     print $fh "</$nodename>";
  795.                 }
  796.         } else {
  797.         print $fh "/>";
  798.         }
  799.  
  800.         for my $lang (sort keys %po_files_by_lang) {
  801.                     if ($MULTIPLE_OUTPUT && $lang ne "$language") {
  802.                         next;
  803.                     }
  804.             if ($lang) {
  805.                         # Handle translation
  806.                         #
  807.                         my $translate = 0;
  808.                         my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
  809.                         my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
  810.                         if ($translate && !$translation) {
  811.                             $translation = $lookup;
  812.                         }
  813.  
  814.                         if ($translation || $translate) {
  815.                 print $fh "\n";
  816.                 $leading_space =~ s/.*\n//g;
  817.                 print $fh $leading_space;
  818.                  print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
  819.                             if ($translate == 2) {
  820.                                translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
  821.                             } else {
  822.                                 print $fh $translation;
  823.                             }
  824.                             print $fh "</$nodename>";
  825.             }
  826.                     }
  827.         }
  828.  
  829.     } else {
  830.         my $count = scalar(@all);
  831.         if ($count > 0) {
  832.         print $fh ">";
  833.                 my $index = 0;
  834.                 while ($index < $count) {
  835.                     my $type = $all[$index];
  836.                     my $rest = $all[$index+1];
  837.                     traverse($fh, $type, $rest, $language, $spacepreserve);
  838.                     $index += 2;
  839.                 }
  840.         print $fh "</$nodename>";
  841.         } else {
  842.         print $fh "/>";
  843.         }
  844.     }
  845.     }
  846. }
  847.  
  848. sub intltool_tree_comment
  849. {
  850.     my $expat = shift;
  851.     my $data  = shift;
  852.     my $clist = $expat->{Curlist};
  853.     my $pos   = $#$clist;
  854.  
  855.     push @$clist, 1 => $data;
  856. }
  857.  
  858. sub intltool_tree_cdatastart
  859. {
  860.     my $expat    = shift;
  861.     my $clist = $expat->{Curlist};
  862.     my $pos   = $#$clist;
  863.  
  864.     push @$clist, 0 => $expat->original_string();
  865. }
  866.  
  867. sub intltool_tree_cdataend
  868. {
  869.     my $expat    = shift;
  870.     my $clist = $expat->{Curlist};
  871.     my $pos   = $#$clist;
  872.  
  873.     $clist->[$pos] .= $expat->original_string();
  874. }
  875.  
  876. sub intltool_tree_char
  877. {
  878.     my $expat = shift;
  879.     my $text  = shift;
  880.     my $clist = $expat->{Curlist};
  881.     my $pos   = $#$clist;
  882.  
  883.     # Use original_string so that we retain escaped entities
  884.     # in CDATA sections.
  885.     #
  886.     if ($pos > 0 and $clist->[$pos - 1] eq '0') {
  887.         $clist->[$pos] .= $expat->original_string();
  888.     } else {
  889.         push @$clist, 0 => $expat->original_string();
  890.     }
  891. }
  892.  
  893. sub intltool_tree_start
  894. {
  895.     my $expat    = shift;
  896.     my $tag      = shift;
  897.     my @origlist = ();
  898.  
  899.     # Use original_string so that we retain escaped entities
  900.     # in attribute values.  We must convert the string to an
  901.     # @origlist array to conform to the structure of the Tree
  902.     # Style.
  903.     #
  904.     my @original_array = split /\x/, $expat->original_string();
  905.     my $source         = $expat->original_string();
  906.  
  907.     # Remove leading tag.
  908.     #
  909.     $source =~ s|^\s*<\s*(\S+)||s;
  910.  
  911.     # Grab attribute key/value pairs and push onto @origlist array.
  912.     #
  913.     while ($source)
  914.     {
  915.        if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
  916.        {
  917.            $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
  918.            push @origlist, $1;
  919.            push @origlist, '"' . $2 . '"';
  920.        }
  921.        elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
  922.        {
  923.            $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
  924.            push @origlist, $1;
  925.            push @origlist, "'" . $2 . "'";
  926.        }
  927.        else
  928.        {
  929.            last;
  930.        }
  931.     }
  932.  
  933.     my $ol = [ { @origlist } ];
  934.  
  935.     push @{ $expat->{Lists} }, $expat->{Curlist};
  936.     push @{ $expat->{Curlist} }, $tag => $ol;
  937.     $expat->{Curlist} = $ol;
  938. }
  939.  
  940. sub readXml
  941. {
  942.     my $filename = shift || return;
  943.     if(!-f $filename) {
  944.         die "ERROR Cannot find filename: $filename\n";
  945.     }
  946.  
  947.     my $ret = eval 'require XML::Parser';
  948.     if(!$ret) {
  949.         die "You must have XML::Parser installed to run $0\n\n";
  950.     } 
  951.     my $xp = new XML::Parser(Style => 'Tree');
  952.     $xp->setHandlers(Char => \&intltool_tree_char);
  953.     $xp->setHandlers(Start => \&intltool_tree_start);
  954.     $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
  955.     $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
  956.     my $tree = $xp->parsefile($filename);
  957.  
  958. # <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
  959. # would be:
  960. # [foo, [{}, head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, [{},
  961. # 0, "Howdy",  ref, [{}]], 0, "do" ] ]
  962.  
  963.     return $tree;
  964. }
  965.  
  966. sub print_header
  967. {
  968.     my $infile = shift;
  969.     my $fh = shift;
  970.     my $source;
  971.  
  972.     if(!-f $infile) {
  973.         die "ERROR Cannot find filename: $infile\n";
  974.     }
  975.  
  976.     print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
  977.     {
  978.         local $/;
  979.         open DOCINPUT, "<${FILE}" or die;
  980.         $source = <DOCINPUT>;
  981.         close DOCINPUT;
  982.     }
  983.     if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
  984.     {
  985.         print $fh "$1\n";
  986.     }
  987.     elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
  988.     {
  989.         print $fh "$1\n";
  990.     }
  991. }
  992.  
  993. sub parseTree
  994. {
  995.     my $fh        = shift;
  996.     my $ref       = shift;
  997.     my $language  = shift || "";
  998.  
  999.     my $name = shift @{ $ref };
  1000.     my $cont = shift @{ $ref };
  1001.     
  1002.     while (!$name || "$name" eq "1") {
  1003.         $name = shift @{ $ref };
  1004.         $cont = shift @{ $ref };
  1005.     }
  1006.  
  1007.     my $spacepreserve = 0;
  1008.     my $attrs = @{$cont}[0];
  1009.     $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
  1010.  
  1011.     traverse($fh, $name, $cont, $language, $spacepreserve);
  1012. }
  1013.  
  1014. sub xml_merge_output
  1015. {
  1016.     my $source;
  1017.  
  1018.     if ($MULTIPLE_OUTPUT) {
  1019.         for my $lang (sort keys %po_files_by_lang) {
  1020.         if ( ! -d $lang ) {
  1021.             mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
  1022.             }
  1023.             open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
  1024.             binmode (OUTPUT) if $^O eq 'MSWin32';
  1025.             my $tree = readXml($FILE);
  1026.             print_header($FILE, \*OUTPUT);
  1027.             parseTree(\*OUTPUT, $tree, $lang);
  1028.             close OUTPUT;
  1029.             print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
  1030.         }
  1031.     } 
  1032.     open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
  1033.     binmode (OUTPUT) if $^O eq 'MSWin32';
  1034.     my $tree = readXml($FILE);
  1035.     print_header($FILE, \*OUTPUT);
  1036.     parseTree(\*OUTPUT, $tree);
  1037.     close OUTPUT;
  1038.     print "CREATED $OUTFILE\n" unless $QUIET_ARG;
  1039. }
  1040.  
  1041. sub keys_merge_translations
  1042. {
  1043.     open INPUT, "<${FILE}" or die;
  1044.     open OUTPUT, ">${OUTFILE}" or die;
  1045.     binmode (OUTPUT) if $^O eq 'MSWin32';
  1046.  
  1047.     while (<INPUT>) 
  1048.     {
  1049.         if (s/^(\s*)_(\w+=(.*))/$1$2/)  
  1050.         {
  1051.         my $string = $3;
  1052.  
  1053.             print OUTPUT;
  1054.  
  1055.         my $non_translated_line = $_;
  1056.  
  1057.             for my $lang (sort keys %po_files_by_lang) 
  1058.             {
  1059.         my $translation = $translations{$lang, $string};
  1060.                 next if !$translation;
  1061.  
  1062.                 $_ = $non_translated_line;
  1063.         s/(\w+)=.*/[$lang]$1=$translation/;
  1064.                 print OUTPUT;
  1065.             }
  1066.     } 
  1067.         else 
  1068.         {
  1069.             print OUTPUT;
  1070.         }
  1071.     }
  1072.  
  1073.     close OUTPUT;
  1074.     close INPUT;
  1075. }
  1076.  
  1077. sub desktop_merge_translations
  1078. {
  1079.     open INPUT, "<${FILE}" or die;
  1080.     open OUTPUT, ">${OUTFILE}" or die;
  1081.     binmode (OUTPUT) if $^O eq 'MSWin32';
  1082.  
  1083.     while (<INPUT>) 
  1084.     {
  1085.         if (s/^(\s*)_(\w+=(.*))/$1$2/)  
  1086.         {
  1087.         my $string = $3;
  1088.  
  1089.             print OUTPUT;
  1090.  
  1091.         my $non_translated_line = $_;
  1092.  
  1093.             for my $lang (sort keys %po_files_by_lang) 
  1094.             {
  1095.                 my $translation = $translations{$lang, $string};
  1096.                 next if !$translation;
  1097.  
  1098.                 $_ = $non_translated_line;
  1099.                 s/(\w+)=.*/${1}[$lang]=$translation/;
  1100.                 print OUTPUT;
  1101.             }
  1102.     } 
  1103.         else 
  1104.         {
  1105.             print OUTPUT;
  1106.         }
  1107.     }
  1108.  
  1109.     close OUTPUT;
  1110.     close INPUT;
  1111. }
  1112.  
  1113. sub schemas_merge_translations
  1114. {
  1115.     my $source;
  1116.  
  1117.     {
  1118.        local $/; # slurp mode
  1119.        open INPUT, "<$FILE" or die "can't open $FILE: $!";
  1120.        $source = <INPUT>;
  1121.        close INPUT;
  1122.     }
  1123.  
  1124.     open OUTPUT, ">$OUTFILE" or die;
  1125.     binmode (OUTPUT) if $^O eq 'MSWin32';
  1126.  
  1127.     # FIXME: support attribute translations
  1128.  
  1129.     # Empty nodes never need translation, so unmark all of them.
  1130.     # For example, <_foo/> is just replaced by <foo/>.
  1131.     $source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
  1132.  
  1133.     while ($source =~ s/
  1134.                         (.*?)
  1135.                         (\s+)(<locale\ name="C">(\s*)
  1136.                             (<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
  1137.                             (<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
  1138.                             (<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*)
  1139.                         <\/locale>)
  1140.                        //sx) 
  1141.     {
  1142.         print OUTPUT $1;
  1143.  
  1144.     my $locale_start_spaces = $2 ? $2 : '';
  1145.     my $default_spaces = $4 ? $4 : '';
  1146.     my $short_spaces = $7 ? $7 : '';
  1147.     my $long_spaces = $10 ? $10 : '';
  1148.     my $locale_end_spaces = $13 ? $13 : '';
  1149.     my $c_default_block = $3 ? $3 : '';
  1150.     my $default_string = $6 ? $6 : '';
  1151.     my $short_string = $9 ? $9 : '';
  1152.     my $long_string = $12 ? $12 : '';
  1153.  
  1154.     print OUTPUT "$locale_start_spaces$c_default_block";
  1155.  
  1156.         $default_string =~ s/\s+/ /g;
  1157.         $default_string = entity_decode($default_string);
  1158.     $short_string =~ s/\s+/ /g;
  1159.     $short_string = entity_decode($short_string);
  1160.     $long_string =~ s/\s+/ /g;
  1161.     $long_string = entity_decode($long_string);
  1162.  
  1163.     for my $lang (sort keys %po_files_by_lang) 
  1164.         {
  1165.         my $default_translation = $translations{$lang, $default_string};
  1166.         my $short_translation = $translations{$lang, $short_string};
  1167.         my $long_translation  = $translations{$lang, $long_string};
  1168.  
  1169.         next if (!$default_translation && !$short_translation && 
  1170.                      !$long_translation);
  1171.  
  1172.         print OUTPUT "\n$locale_start_spaces<locale name=\"$lang\">";
  1173.  
  1174.         print OUTPUT "$default_spaces";    
  1175.  
  1176.         if ($default_translation)
  1177.         {
  1178.             $default_translation = entity_encode($default_translation);
  1179.             print OUTPUT "<default>$default_translation</default>";
  1180.         }
  1181.  
  1182.         print OUTPUT "$short_spaces";
  1183.  
  1184.         if ($short_translation)
  1185.         {
  1186.             $short_translation = entity_encode($short_translation);
  1187.             print OUTPUT "<short>$short_translation</short>";
  1188.         }
  1189.  
  1190.         print OUTPUT "$long_spaces";
  1191.  
  1192.         if ($long_translation)
  1193.         {
  1194.             $long_translation = entity_encode($long_translation);
  1195.             print OUTPUT "<long>$long_translation</long>";
  1196.         }        
  1197.  
  1198.         print OUTPUT "$locale_end_spaces</locale>";
  1199.         }
  1200.     }
  1201.  
  1202.     print OUTPUT $source;
  1203.  
  1204.     close OUTPUT;
  1205. }
  1206.  
  1207. sub rfc822deb_merge_translations
  1208. {
  1209.     my %encodings = ();
  1210.     for my $lang (keys %po_files_by_lang) {
  1211.         $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang}));
  1212.     }
  1213.  
  1214.     my $source;
  1215.  
  1216.     $Text::Wrap::huge = 'overflow';
  1217.     $Text::Wrap::break = qr/\n|\s(?=\S)/;
  1218.  
  1219.     {
  1220.        local $/; # slurp mode
  1221.        open INPUT, "<$FILE" or die "can't open $FILE: $!";
  1222.        $source = <INPUT>;
  1223.        close INPUT;
  1224.     }
  1225.  
  1226.     open OUTPUT, ">${OUTFILE}" or die;
  1227.     binmode (OUTPUT) if $^O eq 'MSWin32';
  1228.  
  1229.     while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
  1230.     {
  1231.         my $sep = $1;
  1232.         my $non_translated_line = $3.$4;
  1233.         my $string = $5;
  1234.         my $underscore = length($2);
  1235.         next if $underscore eq 0 && $non_translated_line =~ /^#/;
  1236.         #  Remove [] dummy strings
  1237.         my $stripped = $string;
  1238.         $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2;
  1239.         $stripped =~ s/\[\s[^\[\]]*\]$//;
  1240.         $non_translated_line .= $stripped;
  1241.  
  1242.         print OUTPUT $sep.$non_translated_line;
  1243.     
  1244.         if ($underscore) 
  1245.         {
  1246.             my @str_list = rfc822deb_split($underscore, $string);
  1247.  
  1248.             for my $lang (sort keys %po_files_by_lang) 
  1249.                 {
  1250.                     my $is_translated = 1;
  1251.                     my $str_translated = '';
  1252.                     my $first = 1;
  1253.                 
  1254.                     for my $str (@str_list) 
  1255.                     {
  1256.                         my $translation = $translations{$lang, $str};
  1257.                     
  1258.                         if (!$translation) 
  1259.                         {
  1260.                             $is_translated = 0;
  1261.                             last;
  1262.                         }
  1263.  
  1264.                     #  $translation may also contain [] dummy
  1265.                         #  strings, mostly to indicate an empty string
  1266.                     $translation =~ s/\[\s[^\[\]]*\]$//;
  1267.                         
  1268.                         if ($first) 
  1269.                         {
  1270.                             if ($underscore eq 2)
  1271.                             {
  1272.                                 $str_translated .= $translation;
  1273.                             }
  1274.                             else
  1275.                             {
  1276.                                 $str_translated .=
  1277.                                     Text::Tabs::expand($translation) .
  1278.                                     "\n";
  1279.                             }
  1280.                         } 
  1281.                         else 
  1282.                         {
  1283.                             if ($underscore eq 2)
  1284.                             {
  1285.                                 $str_translated .= ', ' . $translation;
  1286.                             }
  1287.                             else
  1288.                             {
  1289.                                 $str_translated .= Text::Tabs::expand(
  1290.                                     Text::Wrap::wrap(' ', ' ', $translation)) .
  1291.                                     "\n .\n";
  1292.                             }
  1293.                         }
  1294.                         $first = 0;
  1295.  
  1296.                         #  To fix some problems with Text::Wrap::wrap
  1297.                         $str_translated =~ s/(\n )+\n/\n .\n/g;
  1298.                     }
  1299.                     next unless $is_translated;
  1300.  
  1301.                     $str_translated =~ s/\n \.\n$//;
  1302.                     $str_translated =~ s/\s+$//;
  1303.  
  1304.                     $_ = $non_translated_line;
  1305.                     s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
  1306.                     print OUTPUT;
  1307.                 }
  1308.         }
  1309.     }
  1310.     print OUTPUT "\n";
  1311.  
  1312.     close OUTPUT;
  1313.     close INPUT;
  1314. }
  1315.  
  1316. sub rfc822deb_split 
  1317. {
  1318.     # Debian defines a special way to deal with rfc822-style files:
  1319.     # when a value contain newlines, it consists of
  1320.     #   1.  a short form (first line)
  1321.     #   2.  a long description, all lines begin with a space,
  1322.     #       and paragraphs are separated by a single dot on a line
  1323.     # This routine returns an array of all paragraphs, and reformat
  1324.     # them.
  1325.     # When first argument is 2, the string is a comma separated list of
  1326.     # values.
  1327.     my $type = shift;
  1328.     my $text = shift;
  1329.     $text =~ s/^[ \t]//mg;
  1330.     return (split(/, */, $text, 0)) if $type ne 1;
  1331.     return ($text) if $text !~ /\n/;
  1332.  
  1333.     $text =~ s/([^\n]*)\n//;
  1334.     my @list = ($1);
  1335.     my $str = '';
  1336.  
  1337.     for my $line (split (/\n/, $text)) 
  1338.     {
  1339.         chomp $line;
  1340.         if ($line =~ /^\.\s*$/)
  1341.         {
  1342.             #  New paragraph
  1343.             $str =~ s/\s*$//;
  1344.             push(@list, $str);
  1345.             $str = '';
  1346.         } 
  1347.         elsif ($line =~ /^\s/) 
  1348.         {
  1349.             #  Line which must not be reformatted
  1350.             $str .= "\n" if length ($str) && $str !~ /\n$/;
  1351.             $line =~ s/\s+$//;
  1352.             $str .= $line."\n";
  1353.         } 
  1354.         else 
  1355.         {
  1356.             #  Continuation line, remove newline
  1357.             $str .= " " if length ($str) && $str !~ /\n$/;
  1358.             $str .= $line;
  1359.         }
  1360.     }
  1361.  
  1362.     $str =~ s/\s*$//;
  1363.     push(@list, $str) if length ($str);
  1364.  
  1365.     return @list;
  1366. }
  1367.  
  1368. sub quoted_translation
  1369. {
  1370.     my ($lang, $string) = @_;
  1371.  
  1372.     $string =~ s/\\\"/\"/g;
  1373.  
  1374.     my $translation = $translations{$lang, $string};
  1375.     $translation = $string if !$translation;
  1376.  
  1377.     $translation =~ s/\"/\\\"/g;
  1378.     return $translation
  1379. }
  1380.  
  1381. sub quoted_merge_translations
  1382. {
  1383.     if (!$MULTIPLE_OUTPUT) {
  1384.         print "Quoted only supports Multiple Output.\n";
  1385.         exit(1);
  1386.     }
  1387.  
  1388.     for my $lang (sort keys %po_files_by_lang) {
  1389.         if ( ! -d $lang ) {
  1390.             mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
  1391.         }
  1392.         open INPUT, "<${FILE}" or die;
  1393.         open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
  1394.         binmode (OUTPUT) if $^O eq 'MSWin32';
  1395.         while (<INPUT>) 
  1396.         {
  1397.             s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($lang, $1) . "\""/ge;
  1398.             print OUTPUT;
  1399.         }
  1400.         close OUTPUT;
  1401.         close INPUT;
  1402.     }
  1403. }
  1404.