intltool-debian-0.35.0+20060710.1/0000755000232200023220000000000010454535573016116 5ustar pbuilderpbuilderintltool-debian-0.35.0+20060710.1/Makefile0000644000232200023220000000057410367430711017553 0ustar pbuilderpbuilder prefix = /usr/local DESTDIR = all: @chmod a+x intltool-bin/intltool-* clean: @: install: @[ -d $(DESTDIR)$(prefix)/share/intltool-debian ] || mkdir -p $(DESTDIR)$(prefix)/share/intltool-debian install -m 0755 intltool-bin/intltool-* $(DESTDIR)$(prefix)/share/intltool-debian deb: fakeroot debian/rules clean dh_clean dpkg-buildpackage -rfakeroot -I.git -I.gitignore intltool-debian-0.35.0+20060710.1/debian/0000755000232200023220000000000010507766661017343 5ustar pbuilderpbuilderintltool-debian-0.35.0+20060710.1/debian/control0000644000232200023220000000111010507766661020737 0ustar pbuilderpbuilderSource: intltool-debian Section: devel Priority: optional Maintainer: Nicolas FRANCOIS (Nekral) Standards-Version: 3.7.2 Build-Depends: debhelper (>= 4.0.0) Build-Depends-Indep: perl Package: intltool-debian Architecture: all Depends: perl, gettext Description: Help i18n of RFC822 compliant config files Intltool is a bunch of scripts written by the GNOME project to internationalize many different file formats. This package is a slightly modified version which adds support for RFC822 compliant config files, e.g. Debconf templates files. intltool-debian-0.35.0+20060710.1/debian/rules0000755000232200023220000000124607736654175020434 0ustar pbuilderpbuilder#!/usr/bin/make -f # Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 build: build-stamp build-stamp: dh_testdir $(MAKE) prefix=/usr touch build-stamp clean: dh_testdir dh_testroot rm -f build-stamp $(MAKE) clean dh_clean # Build architecture-independent files here. binary-indep: build dh_testdir dh_testroot dh_clean -k dh_installdocs AUTHORS dh_installdirs $(MAKE) DESTDIR=`pwd`/debian/intltool-debian prefix=/usr install dh_installchangelogs dh_compress dh_fixperms dh_installdeb dh_gencontrol dh_md5sums dh_builddeb binary-arch: # Nothing to do binary: binary-indep binary-arch .PHONY: build clean binary-indep binary-arch binary intltool-debian-0.35.0+20060710.1/debian/changelog0000644000232200023220000002075210507766607021223 0ustar pbuilderpbuilderintltool-debian (0.35.0+20060710.1) unstable; urgency=low * New maintainer. -- Nicolas FRANCOIS (Nekral) Sun, 1 Oct 2006 18:19:23 +0200 intltool-debian (0.35.0+20060710) unstable; urgency=low * Sync CVS: intltool 2006/07/10. * intltool-extract: Fix numbering of template fields. Closes: #377354 Thanks Florentin Duneau for the report and Thomas Huriaux for the patch. -- Denis Barbier Mon, 10 Jul 2006 21:43:23 +0200 intltool-debian (0.34.2+20060621) unstable; urgency=low * intltool-extract: Fields for the first template are now numbered from 1001, for the 2nd template from 2001 and so forth. All references are written into the POT file, which allows podebconf-display-po to handle strings which appear several times in templates. Closes: #374463 Thanks Yuri Kozlov for the report and Thomas Huriaux for the fix. This change will also let podebconf-display-po do a better job when recreating original templates file, in particular it will be able to handle cases when other fields follow Description, as has been discussed in #366227. -- Denis Barbier Wed, 21 Jun 2006 23:34:31 +0200 intltool-debian (0.34.2+20060512) unstable; urgency=low * Sync CVS: intltool 2006/05/12. * intltool-extract: Use C++ comments '//' instead of C comments '/*...*/' to allow '*/' in comments. Closes: #366450 Thanks Christian Perrier * debian/control: Bump Standards-Version: 3.7.2, no changes are needed. * debian/control: As told by lintian, replace Build-Depends-Indep: debhelper by Build-Depends: debhelper because debhelper programs are run by the clean target. -- Denis Barbier Sat, 13 May 2006 01:49:05 +0200 intltool-debian (0.34.2+20060415) unstable; urgency=low * intltool-update: This program called /usr/bin/file to determine file encoding. It is useless in intltool-debian, so this call is dropped indtead of adding an unnecessary dependency. Closes: #362814 Thanks Marc Haber -- Denis Barbier Sat, 15 Apr 2006 22:56:35 +0200 intltool-debian (0.34.2+20060322) unstable; urgency=low * intltool-merge: Under some special circumstances, an English field composed of several paragraphs may contain an empty string. Of course this empty string has no translation, and thus the whole paragraph is untranslated. A better approach is to assume that an empty string has an empty translation. Closes: #357948 Thanks Colin Watson * Update to intltool 0.34.2; there is no change in handling of RFC822 files. -- Denis Barbier Tue, 28 Mar 2006 23:38:30 +0200 intltool-debian (0.34.1+20060220) unstable; urgency=low * intltool-merge: Do not reformat translated templates. This will produce very long lines, but this is already the case with locale or keyboard choosers, so there should be no problem with (c)debconf. * intltool-merge: Comments are now properly discarded. * Comments in the form '#flag:' are interpreted by intltool-extract and intltool-merge. They are helpful when a translatable field is composed of several strings. Recognized keywords are: - #flag:translate: Write only the specified strings into PO files. - #flag:comment: Comments can be defined for each individual string. - #flag:partial: This flag prints translated strings even if they are not fully translated. * See full documentation in po-debconf(7). * Slightly modify intltool-merge and intltool-extract so that inner routines are more similar and thus less error prone. * Add intltool authors into debian/copyright. -- Denis Barbier Wed, 15 Mar 2006 21:44:03 +0100 intltool-debian (0.34.1+20050828) unstable; urgency=low * Update to intltool 0.34.1; there is no change in handling of RFC822 files. * intltool-merge: When a localized short description contains a newline, it is replaced by a space and a warning is reported. Closes: #308581 Thanks Christian Perrier. * debian/control: Bump Standards-Version: 3.6.2 -- Denis Barbier Sun, 28 Aug 2005 00:03:26 +0200 intltool-debian (0.30+20040213) unstable; urgency=low * intltool-extract: A template without translatable fields caused bogus comments in PO files, the next template had a wrong type. Closes: #260086 Thanks Pierre Machard. -- Denis Barbier Sun, 18 Jul 2004 23:58:14 +0200 intltool-debian (0.30+20040212) unstable; urgency=low * Intltool-merge uses Text::Wrap to word-wrap translated templates. But when a long line begins with a space and has many non-space characters, it is split. The resulting template is then wrongly formatted by debconf. The current fix is to detect such lines and put them together. Closes: #236228 In fact there seems to be no reason to reformat the full templates file, but this change is somewhat drastic and care must be taken. * Handle escaped commas in __Choices fields. Those escapes are a cdebconf extension, so until it is accepted by debconf, this new feature won't be documented. Bugreport and patch sent by Matt Kraai, thanks. Closes: #241188 -- Denis Barbier Thu, 1 Apr 2004 00:53:09 +0200 intltool-debian (0.30+20040211) unstable; urgency=low * Sync CVS: intltool 2004/02/11. * intltool-merge: When a Template line has a comment just above, it was concatenated with the previous template. Closes: #232070 -- Denis Barbier Wed, 11 Feb 2004 08:55:21 +0100 intltool-debian (0.27.2+20031023) unstable; urgency=low * intltool-extract: In order to have po-debconf put templates type as a comment in PO files, this script detects if the INTLTOOL_DEBIAN_TYPE environment variable is set and equal to 'po-debconf'. This is a dirty hack until a better solution is found via command-line options. * intltool-extract: Change order of automatic comments in PO files, they previously looked like #. Comments extracted from source files #. Description and now #. Type: select #. Description #. Comments extracted from source files Author comments are the most important part, so put it near English text to catch translators' attention. -- Denis Barbier Thu, 23 Oct 2003 23:04:03 +0200 intltool-debian (0.27.2+20031003) unstable; urgency=low * intltool-merge: If a comment line did contain a colon without any space character before it, the line was not removed. -- Denis Barbier Sat, 4 Oct 2003 00:53:04 +0200 intltool-debian (0.27.2+20030930) unstable; urgency=low * New upstream release: intltool 0.27.2 * Upstream release handles non-ASCII msgids, but this feature is disabled until sarge is released to ensure that gettext 0.12 is available. * Recognize comments in rfc822deb format, i.e. lines beginning with a hash sign are put as comments in PO files. Such lines were already discarded by intltool-merge, except when they contain a colon. In this version, they are always discarded. * Bump Standards-Version: 3.6.1 -- Denis Barbier Tue, 30 Sep 2003 22:05:24 +0200 intltool-debian (0.26+20030525) unstable; urgency=low * intltool-update: Comment lines are not taken into account when determining if the .pot file has changed. -- Denis Barbier Sun, 25 May 2003 01:12:25 +0200 intltool-debian (0.26+20030523) unstable; urgency=low * New upstream release: intltool 0.26 * intltool-update: When only POT-Creation-Date has changed in the .pot file, this file is not updated. -- Denis Barbier Fri, 23 May 2003 23:01:03 +0200 intltool-debian (0.25+20030419) unstable; urgency=low * Initial public release * This is a rearrangement of the po-debconf package needed so that other packages managing RFC822 compliant files can use features similar to those provided by po-debconf. (Closes: #171377) * This package contains the modified intltool scripts, previously shipped in /usr/share/po-debconf, and now in /usr/share/intltool-debian. * Po-debconf will depend on this package when it enters Debian. * Changes are reported upstream, so intltool and intltool-debian should converge; as intltool-debian is still moving, having a separate package helps making quick fixes without breaking GNOME packages. -- Denis Barbier Sat, 19 Apr 2003 23:28:43 +0200 intltool-debian-0.35.0+20060710.1/debian/compat0000644000232200023220000000000207650342360020530 0ustar pbuilderpbuilder4 intltool-debian-0.35.0+20060710.1/debian/README.Debian0000644000232200023220000000074107736653404021406 0ustar pbuilderpbuilderIntltool is a collection of scripts written by the GNOME project to help its localization. It supports many file formats, and I submit patches for our rfc822 format files. They are incorporated upstream, but this support is still not finalized. As debconf l10n is now performed via intltool scripts, the intltool-debian package is intended to quickly fix bugs when found, without breaking the GNOME part. -- Denis Barbier Thu, 2 Oct 2003 00:29:23 +0200 intltool-debian-0.35.0+20060710.1/debian/copyright0000644000232200023220000000113710406076501021261 0ustar pbuilderpbuilderintltool-debian is a derived version of intltool, which is Copyright (C) 2000-2003 Free Software Foundation. Copyright (C) 2000, 2001 Eazel, Inc Intltool maintainers: Rodney Dawes Danilo Šegan Older intltool maintainers: Kenneth Christiansen Darin Adler Maciej Stachowiak This program is released under the terms and conditions of the GNU General Public License (GPL). On Debian GNU/Linux systems, the complete text of the GNU General Public License may be found in `/usr/share/common-licenses/GPL'. intltool-debian-0.35.0+20060710.1/intltool-patches/0000755000232200023220000000000010445616113021375 5ustar pbuilderpbuilderintltool-debian-0.35.0+20060710.1/intltool-patches/intltool-extract.patch0000644000232200023220000001763410454535263025753 0ustar pbuilderpbuilderIndex: intltool-extract.in.in =================================================================== RCS file: /cvs/gnome/intltool/intltool-extract.in.in,v retrieving revision 1.71 diff -u -r1.71 intltool-extract.in.in --- intltool-extract.in.in 23 May 2006 21:08:36 -0000 1.71 +++ intltool-extract.in.in 10 Jul 2006 20:35:58 -0000 @@ -636,31 +636,132 @@ sub type_rfc822deb { ### For rfc822-style Debian configuration files ### - my $lineno = 1; + my $templateNr = 1001; my $type = ''; - while ($input =~ /\G(.*?)(^|\n)(_+)([^:]+):[ \t]*(.*?)(?=\n\S|$)/sg) + while ($input =~ /\G(.*?)(^|\n)(_+)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) { - my ($pre, $newline, $underscore, $tag, $text) = ($1, $2, $3, $4, $5); - while ($pre =~ m/\n/g) - { - $lineno ++; + my ($pre, $newline, $underscore, $tag, $space, $text) = ($1, $2, $3, $4, $5, $6); + if ($pre =~ m/\n\n/) { + while ($pre =~ m/\n\n/g) + { + $templateNr += 1000; + } + $templateNr = sprintf("%d", $templateNr / 1000) * 1000 + 1; } - $lineno += length($newline); my @str_list = rfc822deb_split(length($underscore), $text); + # Dirty hack for po-debconf until a better solution is found. + if (defined($ENV{INTLTOOL_DEBIAN_TYPE}) && $ENV{INTLTOOL_DEBIAN_TYPE} eq 'po-debconf') { + while($pre =~ m/^(Type:\s*\S+)/mig) + { + # This variable has to be persistent because several + # fields may be translated in a single template + $type = $1; + } + $tag = $type . "\n" . $tag if length($type); + } + # Process pseudo-comments + my $usercomment = ''; + while($pre =~ s/(^|\n)#(.*)$//) + { + $usercomment = "\n" . $2 . $usercomment; + } + my @tfields = (); + my @pocomments = (); + if ($usercomment =~ m/^flag:/m) + { + # There is an implicit #flag:comment:* if comments are found before + # any directive. + $usercomment = "\nflag:comment:*".$usercomment + unless $usercomment =~ m/^\nflag:/s; + my @c = split (/\nflag:/, $usercomment); + # The first field may be null + shift (@c) if ($c[0] =~ m/^\s*$/s); + for (@c) + { + if (s/^comment(!?):(\S+)(?=\n|$)//s) + { + rfc822deb_parse_spec($2, $1, 1+$#str_list, '', $_, \@pocomments); + } + elsif (s/^translate(!?):(\S+)(?=\n|$)//s) + { + rfc822deb_parse_spec($2, $1, 1+$#str_list, 0, 1, \@tfields); + } + elsif (s/^partial(?=\n|$)//s) + { + # This command is ignored by intltool-extract + } + else + { + die "Unknown directive: $_\n\nAborting!\n"; + } + } + $usercomment =~ s/(^|\n)flag:[^\n]*(\n|$)//sg; + $usercomment = "\n".$usercomment + if ($usercomment !~ m/^\n/s && $usercomment =~ m/\S/); + } + # By default, print all msgids + rfc822deb_parse_spec('*', '', 1+$#str_list, 0, 1, \@tfields) + if $#tfields == -1; + # By default, print comments before all msgids + rfc822deb_parse_spec('*', '', 1+$#str_list, '', $usercomment, \@pocomments) + if $#pocomments == -1; + my $cnt = 0; for my $str (@str_list) { + $cnt++; $strcount++; + next if (exists($tfields[$cnt]) && $tfields[$cnt] != 1); $messages{$str} = []; - $loc{$str} = $lineno; - $count{$str} = $strcount; - my $usercomment = ''; - while($pre =~ s/(^|\n)#([^\n]*)$//s) - { - $usercomment = "\n" . $2 . $usercomment; + $count{$str} = $strcount unless defined $count{$str}; + if (defined $comments{$str}) { + $comments{$str} .= "\n"; + } else { + $comments{$str} = ""; } - $comments{$str} = $tag . $usercomment; + $comments{$str} .= $tag . $pocomments[$cnt]; + $comments{$str} .= "\nxgettext:no-c-format" if $str =~ /%/; + push (@{$loc{$str}}, $templateNr); + } + $templateNr++; + } + # Note: this adjustment for $offsetlines is not mandatory within + # type_rfc822deb but is kept here as an example for other types, + # if original line numbers are to be preserved. + while (my ($str, $comm) = each %comments) { + my $temp = $comm; + my $offsetlines = 1 + ($temp =~ s/\n//g); + map { $_ -= $offsetlines } @{$loc{$str}}; + } +} + +sub rfc822deb_parse_spec { + my $spec = shift; + my $negate = shift; + my $len = shift; + my $notfound = shift; + my $found = shift; + my $ref = shift; + $spec = ','.$spec.','; + # Replace '*' by all values + my $all = '1-'.$len; + $spec =~ s/\*/$all/g; + # Expand ranges + $spec =~ s/(\d+)-(\d+)/join(",", ($1..$2))/eg; + if ($#{$ref} == -1) + { + push (@{$ref}, $notfound); + for my $cnt (1..$len) + { + $ref->[$cnt] = $notfound; + } + } + for my $cnt (1..$len) + { + if ($spec =~ m/,$cnt,/ && !$negate) { + $ref->[$cnt] .= $found; + } elsif ($spec !~ m/,$cnt,/ && $negate) { + $ref->[$cnt] .= $found; } - $lineno += ($text =~ s/\n//g); } } @@ -677,7 +778,16 @@ my $type = shift; my $text = shift; $text =~ s/^[ \t]//mg; - return (split(/, */, $text, 0)) if $type ne 1; + if ($type ne 1) + { + my @values = (); + for my $value (split(/(? $outfile") || die "Unable to write into $outfile: $!"; + local $/ = "\n\n"; + while () { + next if m/^msgid ""\nmsgstr/m; + print OUT; + } + close IN; + close OUT; +} + sub POFile_Update { -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n"; @@ -793,7 +804,7 @@ $outfile = "$SRCDIR/$lang.po" if ($outfile eq ""); # I think msgmerge won't overwrite old file if merge is not successful - system ("$MSGMERGE", "-o", $outfile, $infile, "$MODULE.pot"); + system ("$MSGMERGE", "-q", "-o", $outfile, $infile, "$MODULE.pot"); } sub Console_WriteError_NotExisting intltool-debian-0.35.0+20060710.1/intltool-patches/intltool-merge.patch0000644000232200023220000002330510454535263025370 0ustar pbuilderpbuilderIndex: intltool-merge.in.in =================================================================== RCS file: /cvs/gnome/intltool/intltool-merge.in.in,v retrieving revision 1.114 diff -u -r1.114 intltool-merge.in.in --- intltool-merge.in.in 23 May 2006 21:08:36 -0000 1.114 +++ intltool-merge.in.in 10 Jul 2006 19:40:52 -0000 @@ -40,7 +40,6 @@ ## Loaded modules use strict; use Getopt::Long; -use Text::Wrap; use File::Basename; my $must_end_tag = -1; @@ -155,7 +154,6 @@ elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) { &preparation; - &print_message; &rfc822deb_merge_translations; &finalize; } @@ -1213,9 +1211,6 @@ my $source; - $Text::Wrap::huge = 'overflow'; - $Text::Wrap::break = qr/\n|\s(?=\S)/; - { local $/; # slurp mode open INPUT, "<$FILE" or die "can't open $FILE: $!"; @@ -1226,93 +1221,173 @@ open OUTPUT, ">${OUTFILE}" or die; binmode (OUTPUT) if $^O eq 'MSWin32'; - while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) + my $last = 0; + while ($source =~ /\G(.*?)(^|\n)(_+)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) { - my $sep = $1; - my $non_translated_line = $3.$4; - my $string = $5; - my $underscore = length($2); - next if $underscore eq 0 && $non_translated_line =~ /^#/; - # Remove [] dummy strings - my $stripped = $string; - $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2; - $stripped =~ s/\[\s[^\[\]]*\]$//; - $non_translated_line .= $stripped; + $last = pos($source); + my ($pre, $newline, $underscore, $tag, $space, $text) = ($1, $2, $3, $4, $5, $6); + my $non_translated_line = $tag.$space; + $underscore = length($underscore); + # Print untranslated fields + my $untranslated_fields = $pre; + $untranslated_fields =~ s/\n#.*//g; + $untranslated_fields =~ s/^#.*(\n|$)//; + print OUTPUT $untranslated_fields; + # Remove [] dummy strings + my $stripped = $text; + $stripped =~ s/\[\s[^\[\]]*\],/,/g + if $underscore == 2; + $stripped =~ s/\[\s[^\[\]]*\]$//; + $non_translated_line .= $stripped; - print OUTPUT $sep.$non_translated_line; + print OUTPUT $newline.$non_translated_line; - if ($underscore) - { - my @str_list = rfc822deb_split($underscore, $string); + if ($underscore) + { + my @str_list = rfc822deb_split($underscore, $text); + my $partial = 0; - for my $lang (sort keys %po_files_by_lang) + # Process pseudo-comments + my @tfields = (); + if ($pre =~ m/^#flag:/m) + { + my @c = split (/\n#flag:/, $pre); + # The first field is null + shift (@c); + for (@c) { - my $is_translated = 1; - my $str_translated = ''; - my $first = 1; - - for my $str (@str_list) + if (s/^comment(!?):(\S+)(?=\n|$)//s) { - my $translation = $translations{$lang, $str}; - - if (!$translation) - { - $is_translated = 0; - last; - } + # This command is ignored by intltool-merge + } + elsif (s/^translate(!?):(\S+)(?=\n|$)//s) + { + rfc822deb_parse_spec($2, $1, 1+$#str_list, 0, 1, \@tfields); + } + elsif (s/^partial(?=\n|$)//s) + { + $partial = 1; + } + else + { + die "Unknown directive: $_\n\nAborting!\n"; + } + } + } + # By default, print all msgids + rfc822deb_parse_spec('*', '', 1+$#str_list, 0, 1, \@tfields) + if $#tfields == -1; - # $translation may also contain [] dummy - # strings, mostly to indicate an empty string - $translation =~ s/\[\s[^\[\]]*\]$//; - - if ($first) - { - if ($underscore eq 2) - { - $str_translated .= $translation; - } - else - { - $str_translated .= - Text::Tabs::expand($translation) . - "\n"; - } - } - else + for my $lang (sort keys %po_files_by_lang) + { + my $is_translated = 1; + my $str_translated = ''; + my $cnt = 0; + + for my $str (@str_list) + { + $cnt++; + my $translation; + if ($tfields[$cnt] && $str ne '') + { + $translation = $translations{$lang, $str}; + if (!$translation) { - if ($underscore eq 2) + if ($partial) { - $str_translated .= ', ' . $translation; + $translation = $str; } else { - $str_translated .= Text::Tabs::expand( - Text::Wrap::wrap(' ', ' ', $translation)) . - "\n .\n"; + $is_translated = 0; + last; } } - $first = 0; + } + else + { + $translation = $str; + } - # To fix some problems with Text::Wrap::wrap - $str_translated =~ s/(\n )+\n/\n .\n/g; + # $translation may also contain [] dummy + # strings, mostly to indicate an empty string + $translation =~ s/\[\s[^\[\]]*\]$//; + + # Escape commas + $translation =~ s/,/\\,/g + if $underscore == 2; + + if ($cnt == 1) + { + print STDERR "WARNING: $lang: spurious newline removed\n" + if $translation =~ s/\n/ /g; + $str_translated .= $translation; + } + else + { + if ($underscore == 2) + { + $str_translated .= ', ' . $translation; + } + else + { + $translation =~ s/\n/\n /g; + $str_translated .= "\n ." unless $cnt == 2; + $str_translated .= "\n " . $translation unless $str eq ''; + } } - next unless $is_translated; + } + next unless $is_translated; - $str_translated =~ s/\n \.\n$//; - $str_translated =~ s/\s+$//; + $str_translated =~ s/\s+$//; + $str_translated = ' '.$str_translated if length ($str_translated) && $str_translated !~ /^\n/s; - $_ = $non_translated_line; - s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s; - print OUTPUT; - } - } + $_ = $non_translated_line; + s/^(\w+):\s*.*/$newline${1}-$lang.$encodings{$lang}:$str_translated/s; + print OUTPUT; + } + } } - print OUTPUT "\n"; + my $tail = substr($source, $last); + $tail .= "\n" unless $tail =~ m/\n$/s; + $tail =~ s/^#.*\n//mg; + + print OUTPUT $tail; close OUTPUT; close INPUT; } +sub rfc822deb_parse_spec { + my $spec = shift; + my $negate = shift; + my $len = shift; + my $notfound = shift; + my $found = shift; + my $ref = shift; + $spec = ','.$spec.','; + # Replace '*' by all values + my $all = '1-'.$len; + $spec =~ s/\*/$all/g; + # Expand ranges + $spec =~ s/(\d+)-(\d+)/join(",", ($1..$2))/eg; + if ($#{$ref} == -1) + { + for my $cnt (1..$len) + { + $ref->[$cnt] = $notfound; + } + } + for my $cnt (1..$len) + { + if ($spec =~ m/,$cnt,/ && !$negate) { + $ref->[$cnt] .= $found; + } elsif ($spec !~ m/,$cnt,/ && $negate) { + $ref->[$cnt] .= $found; + } + } +} + sub rfc822deb_split { # Debian defines a special way to deal with rfc822-style files: @@ -1327,7 +1402,16 @@ my $type = shift; my $text = shift; $text =~ s/^[ \t]//mg; - return (split(/, */, $text, 0)) if $type ne 1; + if ($type ne 1) + { + my @values = (); + for my $value (split(/(? Danilo Šegan Older maintainers: Kenneth Christiansen Darin Adler Maciej Stachowiak intltool-debian-0.35.0+20060710.1/intltool-bin/0000755000232200023220000000000010454534614020523 5ustar pbuilderpbuilderintltool-debian-0.35.0+20060710.1/intltool-bin/intltool-extract0000755000232200023220000006372410454535243024000 0ustar pbuilderpbuilder#!/usr/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- # # The Intltool Message Extractor # # Copyright (C) 2000-2001, 2003 Free Software Foundation. # # Intltool is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation; either version 2 of the # License, or (at your option) any later version. # # Intltool is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # # Authors: Kenneth Christiansen # Darin Adler # ## Release information my $PROGRAM = "intltool-extract"; my $PACKAGE = "intltool"; my $VERSION = "0.35.0"; ## Loaded modules use strict; use File::Basename; use Getopt::Long; ## Scalars used by the option stuff my $TYPE_ARG = "0"; my $LOCAL_ARG = "0"; my $HELP_ARG = "0"; my $VERSION_ARG = "0"; my $UPDATE_ARG = "0"; my $QUIET_ARG = "0"; my $SRCDIR_ARG = "."; my $FILE; my $OUTFILE; my $gettext_type = ""; my $input; my %messages = (); my %loc = (); my %count = (); my %comments = (); my $strcount = 0; my $XMLCOMMENT = ""; ## Use this instead of \w for XML files to handle more possible characters. my $w = "[-A-Za-z0-9._:]"; ## Always print first $| = 1; ## Handle options GetOptions ( "type=s" => \$TYPE_ARG, "local|l" => \$LOCAL_ARG, "help|h" => \$HELP_ARG, "version|v" => \$VERSION_ARG, "update" => \$UPDATE_ARG, "quiet|q" => \$QUIET_ARG, "srcdir=s" => \$SRCDIR_ARG, ) or &error; &split_on_argument; ## Check for options. ## This section will check for the different options. sub split_on_argument { if ($VERSION_ARG) { &version; } elsif ($HELP_ARG) { &help; } elsif ($LOCAL_ARG) { &place_local; &extract; } elsif ($UPDATE_ARG) { &place_normal; &extract; } elsif (@ARGV > 0) { &place_normal; &message; &extract; } else { &help; } } sub place_normal { $FILE = $ARGV[0]; $OUTFILE = "$FILE.h"; } sub place_local { $FILE = $ARGV[0]; $OUTFILE = fileparse($FILE, ()); if (!-e "tmp/") { system("mkdir tmp/"); } $OUTFILE = "./tmp/$OUTFILE.h" } sub determine_type { if ($TYPE_ARG =~ /^gettext\/(.*)/) { $gettext_type=$1 } } ## Sub for printing release information sub version{ print <<_EOF_; ${PROGRAM} (${PACKAGE}) $VERSION Copyright (C) 2000, 2003 Free Software Foundation, Inc. Written by Kenneth Christiansen, 2000. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. _EOF_ exit; } ## Sub for printing usage information sub help { print <<_EOF_; Usage: ${PROGRAM} [OPTION]... [FILENAME] Generates a header file from an XML source file. It grabs all strings between <_translatable_node> and its end tag in XML files. Read manpage (man ${PROGRAM}) for more info. --type=TYPE Specify the file type of FILENAME. Currently supports: "gettext/glade", "gettext/ini", "gettext/keys" "gettext/rfc822deb", "gettext/schemas", "gettext/scheme", "gettext/xml", "gettext/quoted" -l, --local Writes output into current working directory (conflicts with --update) --update Writes output into the same directory the source file reside (conflicts with --local) --srcdir Root of the source tree -v, --version Output version information and exit -h, --help Display this help and exit -q, --quiet Quiet mode Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") or send email to . _EOF_ exit; } ## Sub for printing error messages sub error{ print STDERR "Try `${PROGRAM} --help' for more information.\n"; exit; } sub message { print "Generating C format header file for translation.\n" unless $QUIET_ARG; } sub extract { &determine_type; &convert; open OUT, ">$OUTFILE"; binmode (OUT) if $^O eq 'MSWin32'; &msg_write; close OUT; print "Wrote $OUTFILE\n" unless $QUIET_ARG; } sub convert { ## Reading the file { local (*IN); local $/; #slurp mode open (IN, "<$SRCDIR_ARG/$FILE") || die "can't open $SRCDIR_ARG/$FILE: $!"; $input = ; } &type_ini if $gettext_type eq "ini"; &type_keys if $gettext_type eq "keys"; &type_xml if $gettext_type eq "xml"; &type_glade if $gettext_type eq "glade"; &type_scheme if $gettext_type eq "scheme"; &type_schemas if $gettext_type eq "schemas"; &type_rfc822deb if $gettext_type eq "rfc822deb"; &type_quoted if $gettext_type eq "quoted"; } sub entity_decode_minimal { local ($_) = @_; s/'/'/g; # ' s/"/"/g; # " s/&/&/g; return $_; } sub entity_decode { local ($_) = @_; s/'/'/g; # ' s/"/"/g; # " s/&/&/g; s/<//g; return $_; } sub escape_char { return '\"' if $_ eq '"'; return '\n' if $_ eq "\n"; return '\\\\' if $_ eq '\\'; return $_; } sub escape { my ($string) = @_; return join "", map &escape_char, split //, $string; } sub type_ini { ### For generic translatable desktop files ### while ($input =~ /^_.*=(.*)$/mg) { $messages{$1} = []; } } sub type_keys { ### For generic translatable mime/keys files ### while ($input =~ /^\s*_\w+=(.*)$/mg) { $messages{$1} = []; } } sub type_xml { ### For generic translatable XML files ### my $tree = readXml($input); parseTree(0, $tree); } sub print_var { my $var = shift; my $vartype = ref $var; if ($vartype =~ /ARRAY/) { my @arr = @{$var}; print "[ "; foreach my $el (@arr) { print_var($el); print ", "; } print "] "; } elsif ($vartype =~ /HASH/) { my %hash = %{$var}; print "{ "; foreach my $key (keys %hash) { print "$key => "; print_var($hash{$key}); print ", "; } print "} "; } else { print $var; } } # Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment) sub getAttributeString { my $sub = shift; my $do_translate = shift || 1; my $language = shift || ""; my $translate = shift; my $result = ""; foreach my $e (reverse(sort(keys %{ $sub }))) { my $key = $e; my $string = $sub->{$e}; my $quote = '"'; $string =~ s/^[\s]+//; $string =~ s/[\s]+$//; if ($string =~ /^'.*'$/) { $quote = "'"; } $string =~ s/^['"]//g; $string =~ s/['"]$//g; ## differences from intltool-merge.in.in if ($key =~ /^_/) { $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT; $messages{entity_decode($string)} = []; $$translate = 2; } ## differences end here from intltool-merge.in.in $result .= " $key=$quote$string$quote"; } return $result; } # Verbatim copy from intltool-merge.in.in sub getXMLstring { my $ref = shift; my $spacepreserve = shift || 0; my @list = @{ $ref }; my $result = ""; my $count = scalar(@list); my $attrs = $list[0]; my $index = 1; $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); while ($index < $count) { my $type = $list[$index]; my $content = $list[$index+1]; if (! $type ) { # We've got CDATA if ($content) { # lets strip the whitespace here, and *ONLY* here $content =~ s/\s+/ /gs if (!$spacepreserve); $result .= $content; } } elsif ( "$type" ne "1" ) { # We've got another element $result .= "<$type"; $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements if ($content) { my $subresult = getXMLstring($content, $spacepreserve); if ($subresult) { $result .= ">".$subresult . ""; } else { $result .= "/>"; } } else { $result .= "/>"; } } $index += 2; } return $result; } # Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed # Translate list of nodes if necessary sub translate_subnodes { my $fh = shift; my $content = shift; my $language = shift || ""; my $singlelang = shift || 0; my $spacepreserve = shift || 0; my @nodes = @{ $content }; my $count = scalar(@nodes); my $index = 0; while ($index < $count) { my $type = $nodes[$index]; my $rest = $nodes[$index+1]; traverse($fh, $type, $rest, $language, $spacepreserve); $index += 2; } } # Based on traverse() in intltool-merge.in.in sub traverse { my $fh = shift; # unused, to allow us to sync code between -merge and -extract my $nodename = shift; my $content = shift; my $language = shift || ""; my $spacepreserve = shift || 0; if ($nodename && "$nodename" eq "1") { $XMLCOMMENT = $content; } elsif ($nodename) { # element my @all = @{ $content }; my $attrs = shift @all; my $translate = 0; my $outattr = getAttributeString($attrs, 1, $language, \$translate); if ($nodename =~ /^_/) { $translate = 1; $nodename =~ s/^_//; } my $lookup = ''; $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); if ($translate) { $lookup = getXMLstring($content, $spacepreserve); if (!$spacepreserve) { $lookup =~ s/^\s+//s; $lookup =~ s/\s+$//s; } if ($lookup && $translate != 2) { $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT; $messages{$lookup} = []; } elsif ($translate == 2) { translate_subnodes($fh, \@all, $language, 1, $spacepreserve); } } else { $XMLCOMMENT = ""; my $count = scalar(@all); if ($count > 0) { my $index = 0; while ($index < $count) { my $type = $all[$index]; my $rest = $all[$index+1]; traverse($fh, $type, $rest, $language, $spacepreserve); $index += 2; } } } $XMLCOMMENT = ""; } } # Verbatim copy from intltool-merge.in.in, $fh for compatibility sub parseTree { my $fh = shift; my $ref = shift; my $language = shift || ""; my $name = shift @{ $ref }; my $cont = shift @{ $ref }; while (!$name || "$name" eq "1") { $name = shift @{ $ref }; $cont = shift @{ $ref }; } my $spacepreserve = 0; my $attrs = @{$cont}[0]; $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); traverse($fh, $name, $cont, $language, $spacepreserve); } # Verbatim copy from intltool-merge.in.in sub intltool_tree_comment { my $expat = shift; my $data = $expat->original_string(); my $clist = $expat->{Curlist}; my $pos = $#$clist; $data =~ s/^$//s; push @$clist, 1 => $data; } # Verbatim copy from intltool-merge.in.in sub intltool_tree_cdatastart { my $expat = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; push @$clist, 0 => $expat->original_string(); } # Verbatim copy from intltool-merge.in.in sub intltool_tree_cdataend { my $expat = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; $clist->[$pos] .= $expat->original_string(); } # Verbatim copy from intltool-merge.in.in sub intltool_tree_char { my $expat = shift; my $text = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; # Use original_string so that we retain escaped entities # in CDATA sections. # if ($pos > 0 and $clist->[$pos - 1] eq '0') { $clist->[$pos] .= $expat->original_string(); } else { push @$clist, 0 => $expat->original_string(); } } # Verbatim copy from intltool-merge.in.in sub intltool_tree_start { my $expat = shift; my $tag = shift; my @origlist = (); # Use original_string so that we retain escaped entities # in attribute values. We must convert the string to an # @origlist array to conform to the structure of the Tree # Style. # my @original_array = split /\x/, $expat->original_string(); my $source = $expat->original_string(); # Remove leading tag. # $source =~ s|^\s*<\s*(\S+)||s; # Grab attribute key/value pairs and push onto @origlist array. # while ($source) { if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) { $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; push @origlist, $1; push @origlist, '"' . $2 . '"'; } elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) { $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; push @origlist, $1; push @origlist, "'" . $2 . "'"; } else { last; } } my $ol = [ { @origlist } ]; push @{ $expat->{Lists} }, $expat->{Curlist}; push @{ $expat->{Curlist} }, $tag => $ol; $expat->{Curlist} = $ol; } # Copied from intltool-merge.in.in and added comment handler. sub readXml { my $xmldoc = shift || return; my $ret = eval 'require XML::Parser'; if(!$ret) { die "You must have XML::Parser installed to run $0\n\n"; } my $xp = new XML::Parser(Style => 'Tree'); $xp->setHandlers(Char => \&intltool_tree_char); $xp->setHandlers(Start => \&intltool_tree_start); $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); ## differences from intltool-merge.in.in $xp->setHandlers(Comment => \&intltool_tree_comment); ## differences end here from intltool-merge.in.in my $tree = $xp->parse($xmldoc); #print_var($tree); # Hello thereHowdydo # would be: # [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, # [{}, 0, "Howdy", ref, [{}]], 0, "do" ] ] return $tree; } sub type_schemas { ### For schemas XML files ### # FIXME: We should handle escaped < (less than) while ($input =~ / \s* (\s*(?:\s*)?(.*?)\s*<\/default>\s*)? (\s*(?:\s*)?(.*?)\s*<\/short>\s*)? (\s*(?:\s*)?(.*?)\s*<\/long>\s*)? <\/locale> /sgx) { my @totranslate = ($3,$6,$9); my @eachcomment = ($2,$5,$8); foreach (@totranslate) { my $currentcomment = shift @eachcomment; next if !$_; s/\s+/ /g; $messages{entity_decode_minimal($_)} = []; $comments{entity_decode_minimal($_)} = $currentcomment if (defined($currentcomment)); } } } sub type_rfc822deb { ### For rfc822-style Debian configuration files ### my $templateNr = 1001; my $type = ''; while ($input =~ /\G(.*?)(^|\n)(_+)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) { my ($pre, $newline, $underscore, $tag, $space, $text) = ($1, $2, $3, $4, $5, $6); if ($pre =~ m/\n\n/) { while ($pre =~ m/\n\n/g) { $templateNr += 1000; } $templateNr = sprintf("%d", $templateNr / 1000) * 1000 + 1; } my @str_list = rfc822deb_split(length($underscore), $text); # Dirty hack for po-debconf until a better solution is found. if (defined($ENV{INTLTOOL_DEBIAN_TYPE}) && $ENV{INTLTOOL_DEBIAN_TYPE} eq 'po-debconf') { while($pre =~ m/^(Type:\s*\S+)/mig) { # This variable has to be persistent because several # fields may be translated in a single template $type = $1; } $tag = $type . "\n" . $tag if length($type); } # Process pseudo-comments my $usercomment = ''; while($pre =~ s/(^|\n)#(.*)$//) { $usercomment = "\n" . $2 . $usercomment; } my @tfields = (); my @pocomments = (); if ($usercomment =~ m/^flag:/m) { # There is an implicit #flag:comment:* if comments are found before # any directive. $usercomment = "\nflag:comment:*".$usercomment unless $usercomment =~ m/^\nflag:/s; my @c = split (/\nflag:/, $usercomment); # The first field may be null shift (@c) if ($c[0] =~ m/^\s*$/s); for (@c) { if (s/^comment(!?):(\S+)(?=\n|$)//s) { rfc822deb_parse_spec($2, $1, 1+$#str_list, '', $_, \@pocomments); } elsif (s/^translate(!?):(\S+)(?=\n|$)//s) { rfc822deb_parse_spec($2, $1, 1+$#str_list, 0, 1, \@tfields); } elsif (s/^partial(?=\n|$)//s) { # This command is ignored by intltool-extract } else { die "Unknown directive: $_\n\nAborting!\n"; } } $usercomment =~ s/(^|\n)flag:[^\n]*(\n|$)//sg; $usercomment = "\n".$usercomment if ($usercomment !~ m/^\n/s && $usercomment =~ m/\S/); } # By default, print all msgids rfc822deb_parse_spec('*', '', 1+$#str_list, 0, 1, \@tfields) if $#tfields == -1; # By default, print comments before all msgids rfc822deb_parse_spec('*', '', 1+$#str_list, '', $usercomment, \@pocomments) if $#pocomments == -1; my $cnt = 0; for my $str (@str_list) { $cnt++; $strcount++; next if (exists($tfields[$cnt]) && $tfields[$cnt] != 1); $messages{$str} = []; $count{$str} = $strcount unless defined $count{$str}; if (defined $comments{$str}) { $comments{$str} .= "\n"; } else { $comments{$str} = ""; } $comments{$str} .= $tag . $pocomments[$cnt]; $comments{$str} .= "\nxgettext:no-c-format" if $str =~ /%/; push (@{$loc{$str}}, $templateNr); } $templateNr++; } # Note: this adjustment for $offsetlines is not mandatory within # type_rfc822deb but is kept here as an example for other types, # if original line numbers are to be preserved. while (my ($str, $comm) = each %comments) { my $temp = $comm; my $offsetlines = 1 + ($temp =~ s/\n//g); map { $_ -= $offsetlines } @{$loc{$str}}; } } sub rfc822deb_parse_spec { my $spec = shift; my $negate = shift; my $len = shift; my $notfound = shift; my $found = shift; my $ref = shift; $spec = ','.$spec.','; # Replace '*' by all values my $all = '1-'.$len; $spec =~ s/\*/$all/g; # Expand ranges $spec =~ s/(\d+)-(\d+)/join(",", ($1..$2))/eg; if ($#{$ref} == -1) { push (@{$ref}, $notfound); for my $cnt (1..$len) { $ref->[$cnt] = $notfound; } } for my $cnt (1..$len) { if ($spec =~ m/,$cnt,/ && !$negate) { $ref->[$cnt] .= $found; } elsif ($spec !~ m/,$cnt,/ && $negate) { $ref->[$cnt] .= $found; } } } sub rfc822deb_split { # Debian defines a special way to deal with rfc822-style files: # when a value contain newlines, it consists of # 1. a short form (first line) # 2. a long description, all lines begin with a space, # and paragraphs are separated by a single dot on a line # This routine returns an array of all paragraphs, and reformat # them. # When first argument is 2, the string is a comma separated list of # values. my $type = shift; my $text = shift; $text =~ s/^[ \t]//mg; if ($type ne 1) { my @values = (); for my $value (split(/(?([^<]+)<\/($tags)>/sg) { # Glade sometimes uses tags that normally mark translatable things for # little bits of non-translatable content. We work around this by not # translating strings that only includes something like label4 or window1. $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/; } while ($input =~ /(..[^<]*)<\/items>/sg) { for my $item (split (/\n/, $1)) { $messages{entity_decode($item)} = []; } } ## handle new glade files while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) { $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/; if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) { $comments{entity_decode($3)} = entity_decode($2) ; } } while ($input =~ /]*)"\s+description="([^>]+)"\/>/sg) { $messages{entity_decode_minimal($2)} = []; } } sub type_scheme { my ($line, $i, $state, $str, $trcomment, $char); for $line (split(/\n/, $input)) { $i = 0; $state = 0; # 0 - nothing, 1 - string, 2 - translatable string while ($i < length($line)) { if (substr($line,$i,1) eq "\"") { if ($state == 2) { $comments{$str} = $trcomment if ($trcomment); $messages{$str} = []; $str = ''; $state = 0; $trcomment = ""; } elsif ($state == 1) { $str = ''; $state = 0; $trcomment = ""; } else { $state = 1; $str = ''; if ($i>0 && substr($line,$i-1,1) eq '_') { $state = 2; } } } elsif (!$state) { if (substr($line,$i,1) eq ";") { $trcomment = substr($line,$i+1); $trcomment =~ s/^;*\s*//; $i = length($line); } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) { $trcomment = ""; } } else { if (substr($line,$i,1) eq "\\") { $char = substr($line,$i+1,1); if ($char ne "\"" && $char ne "\\") { $str = $str . "\\"; } $i++; } $str = $str . substr($line,$i,1); } $i++; } } } sub msg_write { for my $msg (keys %comments) { $comments{$msg} =~ s,^,// ,mg; $comments{$msg} .= "\n"; } my @msgids; if (%count) { @msgids = sort { $count{$a} <=> $count{$b} } keys %count; } else { @msgids = sort keys %messages; } for my $message (@msgids) { my $text = ""; $text .= $comments{$message} if defined $comments{$message}; my @lines = split (/\n/, $message, -1); for (my $n = 0; $n < @lines; $n++) { $text .= $n == 0 ? "char *s = N_(\"" : " \""; $text .= escape($lines[$n]); $text .= $n < @lines - 1 ? "\\n\"\n" : "\");\n"; } if (defined $loc{$message}) { map {print OUT "# ".$_." \"$FILE\"\n$text"} @{$loc{$message}}; } else { print OUT $text; } } } intltool-debian-0.35.0+20060710.1/intltool-bin/intltool-update0000755000232200023220000006756710454535243023621 0ustar pbuilderpbuilder#!/usr/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- # # The Intltool Message Updater # # Copyright (C) 2000-2003 Free Software Foundation. # # Intltool is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # version 2 published by the Free Software Foundation. # # Intltool is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # # Authors: Kenneth Christiansen # Maciej Stachowiak # Darin Adler ## Release information my $PROGRAM = "intltool-update"; my $VERSION = "0.35.0"; my $PACKAGE = "intltool"; ## Loaded modules use strict; use Getopt::Long; use Cwd; use File::Copy; use File::Find; ## Scalars used by the option stuff my $HELP_ARG = 0; my $VERSION_ARG = 0; my $DIST_ARG = 0; my $POT_ARG = 0; my $HEADERS_ARG = 0; my $MAINTAIN_ARG = 0; my $REPORT_ARG = 0; my $VERBOSE = 0; my $GETTEXT_PACKAGE = ""; my $OUTPUT_FILE = ""; my @languages; my %varhash = (); my %po_files_by_lang = (); # Regular expressions to categorize file types. # FIXME: Please check if the following is correct my $xml_support = "xml(?:\\.in)*|". # http://www.w3.org/XML/ (Note: .in is not required) "ui|". # Bonobo specific - User Interface desc. files "lang|". # ? "glade2?(?:\\.in)*|". # Glade specific - User Interface desc. files (Note: .in is not required) "scm(?:\\.in)*|". # ? (Note: .in is not required) "oaf(?:\\.in)+|". # DEPRECATED: Replaces by Bonobo .server files "etspec|". # ? "server(?:\\.in)+|". # Bonobo specific "sheet(?:\\.in)+|". # ? "schemas(?:\\.in)+|". # GConf specific "pong(?:\\.in)+|". # DEPRECATED: PONG is not used [by GNOME] any longer. "kbd(?:\\.in)+"; # GOK specific. my $ini_support = "icon(?:\\.in)+|". # http://www.freedesktop.org/Standards/icon-theme-spec "desktop(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec "caves(?:\\.in)+|". # GNOME Games specific "directory(?:\\.in)+|". # http://www.freedesktop.org/Standards/menu-spec "soundlist(?:\\.in)+|". # GNOME specific "keys(?:\\.in)+|". # GNOME Mime database specific "theme(?:\\.in)+|". # http://www.freedesktop.org/Standards/icon-theme-spec "service(?:\\.in)+"; # DBus specific my $buildin_gettext_support = "c|y|cs|cc|cpp|c\\+\\+|h|hh|gob|py"; ## Always flush buffer when printing $| = 1; ## Sometimes the source tree will be rooted somewhere else. my $SRCDIR = "."; my $POTFILES_in; $SRCDIR = $ENV{"srcdir"} if $ENV{"srcdir"}; $POTFILES_in = "<$SRCDIR/POTFILES.in"; my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null'); ## Handle options GetOptions ( "help" => \$HELP_ARG, "version" => \$VERSION_ARG, "dist|d" => \$DIST_ARG, "pot|p" => \$POT_ARG, "headers|s" => \$HEADERS_ARG, "maintain|m" => \$MAINTAIN_ARG, "report|r" => \$REPORT_ARG, "verbose|x" => \$VERBOSE, "gettext-package|g=s" => \$GETTEXT_PACKAGE, "output-file|o=s" => \$OUTPUT_FILE, ) or &Console_WriteError_InvalidOption; &Console_Write_IntltoolHelp if $HELP_ARG; &Console_Write_IntltoolVersion if $VERSION_ARG; my $arg_count = ($DIST_ARG > 0) + ($POT_ARG > 0) + ($HEADERS_ARG > 0) + ($MAINTAIN_ARG > 0) + ($REPORT_ARG > 0); &Console_Write_IntltoolHelp if $arg_count > 1; # --version and --help don't require a module name my $MODULE = $GETTEXT_PACKAGE || &FindPackageName || "unknown"; if ($POT_ARG) { &GenerateHeaders; &GeneratePOTemplate; } elsif ($HEADERS_ARG) { &GenerateHeaders; } elsif ($MAINTAIN_ARG) { &FindLeftoutFiles; } elsif ($REPORT_ARG) { &GenerateHeaders; &GeneratePOTemplate; &Console_Write_CoverageReport; } elsif ((defined $ARGV[0]) && $ARGV[0] =~ /^[a-z]/) { my $lang = $ARGV[0]; ## Report error if the language file supplied ## to the command line is non-existent &Console_WriteError_NotExisting("$SRCDIR/$lang.po") if ! -s "$SRCDIR/$lang.po"; if (!$DIST_ARG) { print "Working, please wait..." if $VERBOSE; &GenerateHeaders; &GeneratePOTemplate; } &POFile_Update ($lang, $OUTPUT_FILE); &Console_Write_TranslationStatus ($lang, $OUTPUT_FILE) if $VERBOSE; } else { &Console_Write_IntltoolHelp; } exit; ######### sub Console_Write_IntltoolVersion { print <<_EOF_; ${PROGRAM} (${PACKAGE}) $VERSION Written by Kenneth Christiansen, Maciej Stachowiak, and Darin Adler. Copyright (C) 2000-2003 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. _EOF_ exit; } sub Console_Write_IntltoolHelp { print <<_EOF_; Usage: ${PROGRAM} [OPTION]... LANGCODE Updates PO template files and merge them with the translations. Mode of operation (only one is allowed): -p, --pot generate the PO template only -s, --headers generate the header files in POTFILES.in -m, --maintain search for left out files from POTFILES.in -r, --report display a status report for the module -d, --dist merge LANGCODE.po with existing PO template Extra options: -g, --gettext-package=NAME override PO template name, useful with --pot -o, --output-file=FILE write merged translation to FILE -x, --verbose display lots of feedback --help display this help and exit --version output version information and exit Examples of use: ${PROGRAM} --pot just create a new PO template ${PROGRAM} xy create new PO template and merge xy.po with it Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") or send email to . _EOF_ exit; } sub echo_n { my $str = shift; my $ret = `echo "$str"`; $ret =~ s/\n$//; # do we need the "s" flag? return $ret; } sub POFile_DetermineType ($) { my $type = $_; my $gettext_type; my $xml_regex = "(?:" . $xml_support . ")"; my $ini_regex = "(?:" . $ini_support . ")"; my $buildin_regex = "(?:" . $buildin_gettext_support . ")"; if ($type =~ /\[type: gettext\/([^\]].*)]/) { $gettext_type=$1; } elsif ($type =~ /schemas(\.in)+$/) { $gettext_type="schemas"; } elsif ($type =~ /glade2?(\.in)*$/) { $gettext_type="glade"; } elsif ($type =~ /scm(\.in)*$/) { $gettext_type="scheme"; } elsif ($type =~ /keys(\.in)+$/) { $gettext_type="keys"; } # bucket types elsif ($type =~ /$xml_regex$/) { $gettext_type="xml"; } elsif ($type =~ /$ini_regex$/) { $gettext_type="ini"; } elsif ($type =~ /$buildin_regex$/) { $gettext_type="buildin"; } else { $gettext_type="unknown"; } return "gettext\/$gettext_type"; } sub TextFile_DetermineEncoding ($) { my $gettext_code="ASCII"; # All files are ASCII by default return $gettext_code; } sub isNotValidMissing { my ($file) = @_; return if $file =~ /^\{arch\}\/.*$/; return if $file =~ /^$varhash{"PACKAGE"}-$varhash{"VERSION"}\/.*$/; } sub FindLeftoutFiles { my (@buf_i18n_plain, @buf_i18n_xml, @buf_i18n_xml_unmarked, @buf_i18n_ini, @buf_potfiles, @buf_potfiles_ignore, @buf_allfiles, @buf_allfiles_sorted, @buf_potfiles_sorted ); ## Search and find all translatable files find sub { push @buf_i18n_plain, "$File::Find::name" if /\.($buildin_gettext_support)$/; push @buf_i18n_xml, "$File::Find::name" if /\.($xml_support)$/; push @buf_i18n_ini, "$File::Find::name" if /\.($ini_support)$/; push @buf_i18n_xml_unmarked, "$File::Find::name" if /\.(schemas(\.in)+)$/; }, ".."; open POTFILES, $POTFILES_in or die "$PROGRAM: there's no POTFILES.in!\n"; @buf_potfiles = grep !/^(#|\s*$)/, ; close POTFILES; foreach (@buf_potfiles) { s/^\[.*]\s*//; } print "Searching for missing translatable files...\n" if $VERBOSE; ## Check if we should ignore some found files, when ## comparing with POTFILES.in foreach my $ignore ("POTFILES.skip", "POTFILES.ignore") { (-s $ignore) or next; if ("$ignore" eq "POTFILES.ignore") { print "The usage of POTFILES.ignore is deprecated. Please consider moving the\n". "content of this file to POTFILES.skip.\n"; } print "Found $ignore: Ignoring files...\n" if $VERBOSE; open FILE, "<$ignore" or die "ERROR: Failed to open $ignore!\n"; while () { push @buf_potfiles_ignore, $_ unless /^(#|\s*$)/; } close FILE; @buf_potfiles = (@buf_potfiles_ignore, @buf_potfiles); } foreach my $file (@buf_i18n_plain) { my $in_comment = 0; my $in_macro = 0; open FILE, "<$file"; while () { # Handle continued multi-line comment. if ($in_comment) { next unless s-.*\*/--; $in_comment = 0; } # Handle continued macro. if ($in_macro) { $in_macro = 0 unless /\\$/; next; } # Handle start of macro (or any preprocessor directive). if (/^\s*\#/) { $in_macro = 1 if /^([^\\]|\\.)*\\$/; next; } # Handle comments and quoted text. while (m-(/\*|//|\'|\")-) # \' and \" keep emacs perl mode happy { my $match = $1; if ($match eq "/*") { if (!s-/\*.*?\*/--) { s-/\*.*--; $in_comment = 1; } } elsif ($match eq "//") { s-//.*--; } else # ' or " { if (!s-$match([^\\]|\\.)*?$match-QUOTEDTEXT-) { warn "mismatched quotes at line $. in $file\n"; s-$match.*--; } } } if (/\.GetString ?\(QUOTEDTEXT/) { if (defined isNotValidMissing (unpack("x3 A*", $file))) { ## Remove the first 3 chars and add newline push @buf_allfiles, unpack("x3 A*", $file) . "\n"; } last; } if (/_\(QUOTEDTEXT/) { if (defined isNotValidMissing (unpack("x3 A*", $file))) { ## Remove the first 3 chars and add newline push @buf_allfiles, unpack("x3 A*", $file) . "\n"; } last; } } close FILE; } foreach my $file (@buf_i18n_xml) { open FILE, "<$file"; while () { # FIXME: share the pattern matching code with intltool-extract if (/\s_[-A-Za-z0-9._:]+\s*=\s*\"([^"]+)\"/ || /<_[^>]+>/ || /translatable=\"yes\"/) { if (defined isNotValidMissing (unpack("x3 A*", $file))) { push @buf_allfiles, unpack("x3 A*", $file) . "\n"; } last; } } close FILE; } foreach my $file (@buf_i18n_ini) { open FILE, "<$file"; while () { if (/_(.*)=/) { if (defined isNotValidMissing (unpack("x3 A*", $file))) { push @buf_allfiles, unpack("x3 A*", $file) . "\n"; } last; } } close FILE; } foreach my $file (@buf_i18n_xml_unmarked) { if (defined isNotValidMissing (unpack("x3 A*", $file))) { push @buf_allfiles, unpack("x3 A*", $file) . "\n"; } } @buf_allfiles_sorted = sort (@buf_allfiles); @buf_potfiles_sorted = sort (@buf_potfiles); my %in2; foreach (@buf_potfiles_sorted) { $in2{$_} = 1; } my @result; foreach (@buf_allfiles_sorted) { if (!exists($in2{$_})) { push @result, $_ } } my @buf_potfiles_notexist; foreach (@buf_potfiles_sorted) { chomp (my $dummy = $_); if ("$dummy" ne "" and ! -f "../$dummy") { push @buf_potfiles_notexist, $_; } } ## Save file with information about the files missing ## if any, and give information about this procedure. if (@result + @buf_potfiles_notexist > 0) { if (@result) { print "\n" if $VERBOSE; unlink "missing"; open OUT, ">missing"; print OUT @result; close OUT; warn "\e[1mThe following files contain translations and are currently not in use. Please\e[0m\n". "\e[1mconsider adding these to the POTFILES.in file, located in the po/ directory.\e[0m\n\n"; print STDERR @result, "\n"; warn "If some of these files are left out on purpose then please add them to\n". "POTFILES.skip instead of POTFILES.in. A file \e[1m'missing'\e[0m containing this list\n". "of left out files has been written in the current directory.\n"; } if (@buf_potfiles_notexist) { unlink "notexist"; open OUT, ">notexist"; print OUT @buf_potfiles_notexist; close OUT; warn "\n" if ($VERBOSE or @result); warn "\e[1mThe following files do not exist anymore:\e[0m\n\n"; warn @buf_potfiles_notexist, "\n"; warn "Please remove them from POTFILES.in or POTFILES.skip. A file \e[1m'notexist'\e[0m\n". "containing this list of absent files has been written in the current directory.\n"; } } ## If there is nothing to complain about, notify the user else { print "\nAll files containing translations are present in POTFILES.in.\n" if $VERBOSE; } } sub Console_WriteError_InvalidOption { ## Handle invalid arguments print STDERR "Try `${PROGRAM} --help' for more information.\n"; exit 1; } sub GenerateHeaders { my $EXTRACT = "/usr/bin/intltool-extract"; chomp $EXTRACT; $EXTRACT = $ENV{"INTLTOOL_EXTRACT"} if $ENV{"INTLTOOL_EXTRACT"}; ## Generate the .h header files, so we can allow glade and ## xml translation support if (! -x "$EXTRACT") { print STDERR "\n *** The intltool-extract script wasn't found!" ."\n *** Without it, intltool-update can not generate files.\n"; exit; } else { open (FILE, $POTFILES_in) or die "$PROGRAM: POTFILES.in not found.\n"; while () { chomp; next if /^\[\s*encoding/; ## Find xml files in POTFILES.in and generate the ## files with help from the extract script my $gettext_type= &POFile_DetermineType ($1); if (/\.($xml_support|$ini_support)$/ || /^\[/) { s/^\[[^\[].*]\s*//; my $filename = "../$_"; if ($VERBOSE) { system ($EXTRACT, "--update", "--srcdir=$SRCDIR", "--type=$gettext_type", $filename); } else { system ($EXTRACT, "--update", "--type=$gettext_type", "--srcdir=$SRCDIR", "--quiet", $filename); } } } close FILE; } } # # Generate .pot file from POTFILES.in # sub GeneratePOTemplate { my $XGETTEXT = $ENV{"XGETTEXT"} || "/usr/bin/xgettext"; my $XGETTEXT_ARGS = $ENV{"XGETTEXT_ARGS"} || ''; chomp $XGETTEXT; if (! -x $XGETTEXT) { print STDERR " *** xgettext is not found on this system!\n". " *** Without it, intltool-update can not extract strings.\n"; exit; } print "Building $MODULE.pot...\n" if $VERBOSE; open INFILE, $POTFILES_in; unlink "POTFILES.in.temp"; open OUTFILE, ">POTFILES.in.temp" or die("Cannot open POTFILES.in.temp for writing"); my $gettext_support_nonascii = 0; # checks for GNU gettext >= 0.12 my $dummy = `$XGETTEXT --version --from-code=UTF-8 >$devnull 2>$devnull`; if ($? == 0) { $gettext_support_nonascii = 1; } else { # urge everybody to upgrade gettext print STDERR "WARNING: This version of gettext does not support extracting non-ASCII\n". " strings. That means you should install a version of gettext\n". " that supports non-ASCII strings (such as GNU gettext >= 0.12),\n". " or have to let non-ASCII strings untranslated. (If there is any)\n"; } my $encoding = "ASCII"; my $forced_gettext_code; my @temp_headers; my $encoding_problem_is_reported = 0; while () { next if (/^#/ or /^\s*$/); chomp; my $gettext_code; if (/^\[\s*encoding:\s*(.*)\s*\]/) { $forced_gettext_code=$1; } elsif (/\.($xml_support|$ini_support)$/ || /^\[/) { s/^\[.*]\s*//; print OUTFILE "../$_.h\n"; push @temp_headers, "../$_.h"; $gettext_code = &TextFile_DetermineEncoding ("../$_.h") if ($gettext_support_nonascii and not defined $forced_gettext_code); } else { if ($SRCDIR eq ".") { print OUTFILE "../$_\n"; } else { print OUTFILE "$SRCDIR/../$_\n"; } $gettext_code = &TextFile_DetermineEncoding ("../$_") if ($gettext_support_nonascii and not defined $forced_gettext_code); } next if (! $gettext_support_nonascii); if (defined $forced_gettext_code) { $encoding=$forced_gettext_code; } elsif (defined $gettext_code and "$encoding" ne "$gettext_code") { if ($encoding eq "ASCII") { $encoding=$gettext_code; } elsif ($gettext_code ne "ASCII") { # Only report once because the message is quite long if (! $encoding_problem_is_reported) { print STDERR "WARNING: You should use the same file encoding for all your project files,\n". " but $PROGRAM thinks that most of the source files are in\n". " $encoding encoding, while \"$_\" is (likely) in\n". " $gettext_code encoding. If you are sure that all translatable strings\n". " are in same encoding (say UTF-8), please \e[1m*prepend*\e[0m the following\n". " line to POTFILES.in:\n\n". " [encoding: UTF-8]\n\n". " and make sure that configure.in/ac checks for $PACKAGE >= 0.27 .\n". "(such warning message will only be reported once.)\n"; $encoding_problem_is_reported = 1; } } } } close OUTFILE; close INFILE; unlink "$MODULE.pot-update"; my @xgettext_argument=("$XGETTEXT", "--add-comments", "--directory\=\.", "--output\=$MODULE\.pot-update", "--files-from\=\.\/POTFILES\.in\.temp"); my $XGETTEXT_KEYWORDS = &FindPOTKeywords; push @xgettext_argument, $XGETTEXT_KEYWORDS; my $MSGID_BUGS_ADDRESS = &FindMakevarsBugAddress; push @xgettext_argument, "--msgid-bugs-address\=$MSGID_BUGS_ADDRESS" if $MSGID_BUGS_ADDRESS; push @xgettext_argument, "--from-code\=$encoding" if ($gettext_support_nonascii); push @xgettext_argument, $XGETTEXT_ARGS if $XGETTEXT_ARGS; my $xgettext_command = join ' ', @xgettext_argument; # intercept xgettext error message print "Running $xgettext_command\n" if $VERBOSE; my $xgettext_error_msg = `$xgettext_command 2>\&1`; my $command_failed = $?; unlink "POTFILES.in.temp"; print "Removing generated header (.h) files..." if $VERBOSE; unlink foreach (@temp_headers); print "done.\n" if $VERBOSE; if (! $command_failed) { if (! -e "$MODULE.pot-update") { print STDERR "None of the files in POTFILES.in contain strings marked for translation.\n"; } if (-e "$MODULE.pot") { RemovePOHeader("$MODULE.pot", "$MODULE.1po"); RemovePOHeader("$MODULE.pot-update", "$MODULE.2po"); system("cmp", "-s", "$MODULE.1po", "$MODULE.2po"); rename("$MODULE.pot-update", "$MODULE.pot") if $?; unlink "$MODULE.1po", "$MODULE.2po", "$MODULE.pot-update"; } else { rename("$MODULE.pot-update", "$MODULE.pot"); } print "Wrote $MODULE.pot\n" if $VERBOSE; } else { if ($xgettext_error_msg =~ /--from-code/) { # replace non-ASCII error message with a more useful one. print STDERR "ERROR: xgettext failed to generate PO template file because there is non-ASCII\n". " string marked for translation. Please make sure that all strings marked\n". " for translation are in uniform encoding (say UTF-8), then \e[1m*prepend*\e[0m the\n". " following line to POTFILES.in and rerun $PROGRAM:\n\n". " [encoding: UTF-8]\n\n"; } else { print STDERR "$xgettext_error_msg"; if (-e "$MODULE.pot-update") { # is this possible? print STDERR "ERROR: xgettext failed but still managed to generate PO template file.\n". " Please consult error message above if there is any.\n"; } else { print STDERR "ERROR: xgettext failed to generate PO template file. Please consult\n". " error message above if there is any.\n"; } } exit (1); } } sub RemovePOHeader { my ($infile, $outfile) = @_; my $first = 1; open (IN, "< $infile") || die "file $infile does not exist"; open (OUT, "> $outfile") || die "Unable to write into $outfile: $!"; local $/ = "\n\n"; while () { next if m/^msgid ""\nmsgstr/m; print OUT; } close IN; close OUT; } sub POFile_Update { -f "$MODULE.pot" or die "$PROGRAM: $MODULE.pot does not exist.\n"; my $MSGMERGE = $ENV{"MSGMERGE"} || "/usr/bin/msgmerge"; my ($lang, $outfile) = @_; print "Merging $SRCDIR/$lang.po with $MODULE.pot..." if $VERBOSE; my $infile = "$SRCDIR/$lang.po"; $outfile = "$SRCDIR/$lang.po" if ($outfile eq ""); # I think msgmerge won't overwrite old file if merge is not successful system ("$MSGMERGE", "-q", "-o", $outfile, $infile, "$MODULE.pot"); } sub Console_WriteError_NotExisting { my ($file) = @_; ## Report error if supplied language file is non-existing print STDERR "$PROGRAM: $file does not exist!\n"; print STDERR "Try '$PROGRAM --help' for more information.\n"; exit; } sub GatherPOFiles { my @po_files = glob ("./*.po"); @languages = map (&POFile_GetLanguage, @po_files); foreach my $lang (@languages) { $po_files_by_lang{$lang} = shift (@po_files); } } sub POFile_GetLanguage ($) { s/^(.*\/)?(.+)\.po$/$2/; return $_; } sub Console_Write_TranslationStatus { my ($lang, $output_file) = @_; my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt"; $output_file = "$SRCDIR/$lang.po" if ($output_file eq ""); system ("$MSGFMT", "-o", "$devnull", "--verbose", $output_file); } sub Console_Write_CoverageReport { my $MSGFMT = $ENV{"MSGFMT"} || "/usr/bin/msgfmt"; &GatherPOFiles; foreach my $lang (@languages) { print "$lang: "; &POFile_Update ($lang, ""); } print "\n\n * Current translation support in $MODULE \n\n"; foreach my $lang (@languages) { print "$lang: "; system ("$MSGFMT", "-o", "$devnull", "--verbose", "$SRCDIR/$lang.po"); } } sub SubstituteVariable { my ($str) = @_; # always need to rewind file whenever it has been accessed seek (CONF, 0, 0); # cache each variable. varhash is global to we can add # variables elsewhere. while () { if (/^(\w+)=(.*)$/) { ($varhash{$1} = $2) =~ s/^["'](.*)["']$/$1/; } } if ($str =~ /^(.*)\${?([A-Z_]+)}?(.*)$/) { my $rest = $3; my $untouched = $1; my $sub = ""; # Ignore recursive definitions of variables $sub = $varhash{$2} if defined $varhash{$2} and $varhash{$2} !~ /\${?$2}?/; return SubstituteVariable ("$untouched$sub$rest"); } # We're using Perl backticks ` and "echo -n" here in order to # expand any shell escapes (such as backticks themselves) in every variable return echo_n ($str); } sub CONF_Handle_Open { my $base_dirname = getcwd(); $base_dirname =~ s@.*/@@; my ($conf_in, $src_dir); if ($base_dirname =~ /^po(-.+)?$/) { if (-f "Makevars") { my $makefile_source; local (*IN); open (IN, ") { if (/^top_builddir[ \t]*=/) { $src_dir = $_; $src_dir =~ s/^top_builddir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/; chomp $src_dir; if (-f "$src_dir" . "/configure.ac") { $conf_in = "$src_dir" . "/configure.ac" . "\n"; } else { $conf_in = "$src_dir" . "/configure.in" . "\n"; } last; } } close IN; $conf_in || die "Cannot find top_builddir in Makevars."; } elsif (-f "../configure.ac") { $conf_in = "../configure.ac"; } elsif (-f "../configure.in") { $conf_in = "../configure.in"; } else { my $makefile_source; local (*IN); open (IN, ") { if (/^top_srcdir[ \t]*=/) { $src_dir = $_; $src_dir =~ s/^top_srcdir[ \t]*=[ \t]*([^ \t\n\r]*)/$1/; chomp $src_dir; $conf_in = "$src_dir" . "/configure.in" . "\n"; last; } } close IN; $conf_in || die "Cannot find top_srcdir in Makefile."; } open (CONF, "<$conf_in"); } else { print STDERR "$PROGRAM: Unable to proceed.\n" . "Make sure to run this script inside the po directory.\n"; exit; } } sub FindPackageName { my $version; my $domain = &FindMakevarsDomain; my $name = $domain || "untitled"; &CONF_Handle_Open; my $conf_source; { local (*IN); open (IN, "<&CONF") || return $name; seek (IN, 0, 0); local $/; # slurp mode $conf_source = ; close IN; } # priority for getting package name: # 1. GETTEXT_PACKAGE # 2. first argument of AC_INIT (with >= 2 arguments) # 3. first argument of AM_INIT_AUTOMAKE (with >= 2 argument) # /^AM_INIT_AUTOMAKE\([\s\[]*([^,\)\s\]]+)/m # the \s makes this not work, why? if ($conf_source =~ /^AM_INIT_AUTOMAKE\(([^,\)]+),([^,\)]+)/m) { ($name, $version) = ($1, $2); $name =~ s/[\[\]\s]//g; $version =~ s/[\[\]\s]//g; $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/); $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/); $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/); $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/); } if ($conf_source =~ /^AC_INIT\(([^,\)]+),([^,\)]+)/m) { ($name, $version) = ($1, $2); $name =~ s/[\[\]\s]//g; $version =~ s/[\[\]\s]//g; $varhash{"PACKAGE_NAME"} = $name if (not $name =~ /\${?AC_PACKAGE_NAME}?/); $varhash{"PACKAGE"} = $name if (not $name =~ /\${?PACKAGE}?/); $varhash{"PACKAGE_VERSION"} = $version if (not $name =~ /\${?AC_PACKAGE_VERSION}?/); $varhash{"VERSION"} = $version if (not $name =~ /\${?VERSION}?/); } # \s makes this not work, why? $name = $1 if $conf_source =~ /^GETTEXT_PACKAGE=\[?([^\n\]]+)/m; # m4 macros AC_PACKAGE_NAME, AC_PACKAGE_VERSION etc. have same value # as corresponding $PACKAGE_NAME, $PACKAGE_VERSION etc. shell variables. $name =~ s/\bAC_PACKAGE_/\$PACKAGE_/g; $name = $domain if $domain; $name = SubstituteVariable ($name); $name =~ s/^["'](.*)["']$/$1/; return $name if $name; } sub FindPOTKeywords { my $keywords = "--keyword\=\_ --keyword\=N\_ --keyword\=U\_ --keyword\=Q\_"; my $varname = "XGETTEXT_OPTIONS"; my $make_source; { local (*IN); open (IN, "; close IN; } $keywords = $1 if $make_source =~ /^$varname[ ]*=\[?([^\n\]]+)/m; return $keywords; } sub FindMakevarsDomain { my $domain = ""; my $makevars_source; { local (*IN); open (IN, "; close IN; } $domain = $1 if $makevars_source =~ /^DOMAIN[ ]*=\[?([^\n\]\$]+)/m; $domain =~ s/^\s+//; $domain =~ s/\s+$//; return $domain; } sub FindMakevarsBugAddress { my $address = ""; my $makevars_source; { local (*IN); open (IN, "; close IN; } $address = $1 if $makevars_source =~ /^MSGID_BUGS_ADDRESS[ ]*=\[?([^\n\]\$]+)/m; $address =~ s/^\s+//; $address =~ s/\s+$//; return $address; } intltool-debian-0.35.0+20060710.1/intltool-bin/intltool-merge0000755000232200023220000011400210454535243023407 0ustar pbuilderpbuilder#!/usr/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4 -*- # # The Intltool Message Merger # # Copyright (C) 2000, 2003 Free Software Foundation. # Copyright (C) 2000, 2001 Eazel, Inc # # Intltool is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # version 2 published by the Free Software Foundation. # # Intltool is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # # Authors: Maciej Stachowiak # Kenneth Christiansen # Darin Adler # # Proper XML UTF-8'ification written by Cyrille Chepelov # ## Release information my $PROGRAM = "intltool-merge"; my $PACKAGE = "intltool"; my $VERSION = "0.35.0"; ## Loaded modules use strict; use Getopt::Long; use File::Basename; my $must_end_tag = -1; my $last_depth = -1; my $translation_depth = -1; my @tag_stack = (); my @entered_tag = (); my @translation_strings = (); my $leading_space = ""; ## Scalars used by the option stuff my $HELP_ARG = 0; my $VERSION_ARG = 0; my $BA_STYLE_ARG = 0; my $XML_STYLE_ARG = 0; my $KEYS_STYLE_ARG = 0; my $DESKTOP_STYLE_ARG = 0; my $SCHEMAS_STYLE_ARG = 0; my $RFC822DEB_STYLE_ARG = 0; my $QUOTED_STYLE_ARG = 0; my $QUIET_ARG = 0; my $PASS_THROUGH_ARG = 0; my $UTF8_ARG = 0; my $MULTIPLE_OUTPUT = 0; my $cache_file; ## Handle options GetOptions ( "help" => \$HELP_ARG, "version" => \$VERSION_ARG, "quiet|q" => \$QUIET_ARG, "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility "ba-style|b" => \$BA_STYLE_ARG, "xml-style|x" => \$XML_STYLE_ARG, "keys-style|k" => \$KEYS_STYLE_ARG, "desktop-style|d" => \$DESKTOP_STYLE_ARG, "schemas-style|s" => \$SCHEMAS_STYLE_ARG, "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG, "quoted-style" => \$QUOTED_STYLE_ARG, "pass-through|p" => \$PASS_THROUGH_ARG, "utf8|u" => \$UTF8_ARG, "multiple-output|m" => \$MULTIPLE_OUTPUT, "cache|c=s" => \$cache_file ) or &error; my $PO_DIR; my $FILE; my $OUTFILE; my %po_files_by_lang = (); my %translations = (); my $iconv = $ENV{"ICONV"} || $ENV{"INTLTOOL_ICONV"} || "/usr/bin/iconv"; my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null'); # Use this instead of \w for XML files to handle more possible characters. my $w = "[-A-Za-z0-9._:]"; # XML quoted string contents my $q = "[^\\\"]*"; ## Check for options. if ($VERSION_ARG) { &print_version; } elsif ($HELP_ARG) { &print_help; } elsif ($BA_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; &ba_merge_translations; &finalize; } elsif ($XML_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; &xml_merge_output; &finalize; } elsif ($KEYS_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; &keys_merge_translations; &finalize; } elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; &desktop_merge_translations; &finalize; } elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; &schemas_merge_translations; &finalize; } elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) { &preparation; &rfc822deb_merge_translations; &finalize; } elsif ($QUOTED_STYLE_ARG && @ARGV > 2) { &utf8_sanity_check; &preparation; &print_message; "ed_merge_translations; &finalize; } else { &print_help; } exit; ## Sub for printing release information sub print_version { print <<_EOF_; ${PROGRAM} (${PACKAGE}) ${VERSION} Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen. Copyright (C) 2000-2003 Free Software Foundation, Inc. Copyright (C) 2000-2001 Eazel, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. _EOF_ exit; } ## Sub for printing usage information sub print_help { print <<_EOF_; Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE Generates an output file that includes some localized attributes from an untranslated source file. Mandatory options: (exactly one must be specified) -b, --ba-style includes translations in the bonobo-activation style -d, --desktop-style includes translations in the desktop style -k, --keys-style includes translations in the keys style -s, --schemas-style includes translations in the schemas style -r, --rfc822deb-style includes translations in the RFC822 style --quoted-style includes translations in the quoted string style -x, --xml-style includes translations in the standard xml style Other options: -u, --utf8 convert all strings to UTF-8 before merging (default for everything except RFC822 style) -p, --pass-through deprecated, does nothing and issues a warning -m, --multiple-output output one localized file per locale, instead of a single file containing all localized elements -c, --cache=FILE specify cache file name (usually \$top_builddir/po/.intltool-merge-cache) -q, --quiet suppress most messages --help display this help and exit --version output version information and exit Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE") or send email to . _EOF_ exit; } ## Sub for printing error messages sub print_error { print STDERR "Try `${PROGRAM} --help' for more information.\n"; exit; } sub print_message { print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG; } sub preparation { $PO_DIR = $ARGV[0]; $FILE = $ARGV[1]; $OUTFILE = $ARGV[2]; &gather_po_files; &get_translation_database; } # General-purpose code for looking up translations in .po files sub po_file2lang { my ($tmp) = @_; $tmp =~ s/^.*\/(.*)\.po$/$1/; return $tmp; } sub gather_po_files { for my $po_file (glob "$PO_DIR/*.po") { $po_files_by_lang{po_file2lang($po_file)} = $po_file; } } sub get_local_charset { my ($encoding) = @_; my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "/usr/lib/charset.alias"; # seek character encoding aliases in charset.alias (glib) if (open CHARSET_ALIAS, $alias_file) { while () { next if /^\#/; return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i) } close CHARSET_ALIAS; } # if not found, return input string return $encoding; } sub get_po_encoding { my ($in_po_file) = @_; my $encoding = ""; open IN_PO_FILE, $in_po_file or die; while () { ## example: "Content-Type: text/plain; charset=ISO-8859-1\n" if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) { $encoding = $1; last; } } close IN_PO_FILE; if (!$encoding) { print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG; $encoding = "ISO-8859-1"; } system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull"); if ($?) { $encoding = get_local_charset($encoding); } return $encoding } sub utf8_sanity_check { print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG; $UTF8_ARG = 1; } sub get_translation_database { if ($cache_file) { &get_cached_translation_database; } else { &create_translation_database; } } sub get_newest_po_age { my $newest_age; foreach my $file (values %po_files_by_lang) { my $file_age = -M $file; $newest_age = $file_age if !$newest_age || $file_age < $newest_age; } $newest_age = 0 if !$newest_age; return $newest_age; } sub create_cache { print "Generating and caching the translation database\n" unless $QUIET_ARG; &create_translation_database; open CACHE, ">$cache_file" || die; print CACHE join "\x01", %translations; close CACHE; } sub load_cache { print "Found cached translation database\n" unless $QUIET_ARG; my $contents; open CACHE, "<$cache_file" || die; { local $/; $contents = ; } close CACHE; %translations = split "\x01", $contents; } sub get_cached_translation_database { my $cache_file_age = -M $cache_file; if (defined $cache_file_age) { if ($cache_file_age <= &get_newest_po_age) { &load_cache; return; } print "Found too-old cached translation database\n" unless $QUIET_ARG; } &create_cache; } sub create_translation_database { for my $lang (keys %po_files_by_lang) { my $po_file = $po_files_by_lang{$lang}; if ($UTF8_ARG) { my $encoding = get_po_encoding ($po_file); if (lc $encoding eq "utf-8") { open PO_FILE, "<$po_file"; } else { print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;; open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; } } else { open PO_FILE, "<$po_file"; } my $nextfuzzy = 0; my $inmsgid = 0; my $inmsgstr = 0; my $msgid = ""; my $msgstr = ""; while () { $nextfuzzy = 1 if /^#, fuzzy/; if (/^msgid "((\\.|[^\\])*)"/ ) { $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; $msgid = ""; $msgstr = ""; if ($nextfuzzy) { $inmsgid = 0; } else { $msgid = unescape_po_string($1); $inmsgid = 1; } $inmsgstr = 0; $nextfuzzy = 0; } if (/^msgstr "((\\.|[^\\])*)"/) { $msgstr = unescape_po_string($1); $inmsgstr = 1; $inmsgid = 0; } if (/^"((\\.|[^\\])*)"/) { $msgid .= unescape_po_string($1) if $inmsgid; $msgstr .= unescape_po_string($1) if $inmsgstr; } } $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr; } } sub finalize { } sub unescape_one_sequence { my ($sequence) = @_; return "\\" if $sequence eq "\\\\"; return "\"" if $sequence eq "\\\""; return "\n" if $sequence eq "\\n"; return "\r" if $sequence eq "\\r"; return "\t" if $sequence eq "\\t"; return "\b" if $sequence eq "\\b"; return "\f" if $sequence eq "\\f"; return "\a" if $sequence eq "\\a"; return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7) return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/); return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/); # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489 return $sequence; } sub unescape_po_string { my ($string) = @_; $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg; return $string; } ## NOTE: deal with < - < but not > - > because it seems its ok to have ## > in the entity. For further info please look at #84738. sub entity_decode { local ($_) = @_; s/'/'/g; # ' s/"/"/g; # " s/&/&/g; s/</; close INPUT; } open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!"; # Binmode so that selftest works ok if using a native Win32 Perl... binmode (OUTPUT) if $^O eq 'MSWin32'; while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) { print OUTPUT $1; my $node = $2 . "\n"; my @strings = (); $_ = $node; while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) { push @strings, entity_decode($3); } print OUTPUT; my %langs; for my $string (@strings) { for my $lang (keys %po_files_by_lang) { $langs{$lang} = 1 if $translations{$lang, $string}; } } for my $lang (sort keys %langs) { $_ = $node; s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s; s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg; print OUTPUT; } } print OUTPUT $source; close OUTPUT; } ## XML (non-bonobo-activation) merge code # Process tag attributes # Only parameter is a HASH containing attributes -> values mapping sub getAttributeString { my $sub = shift; my $do_translate = shift || 0; my $language = shift || ""; my $result = ""; my $translate = shift; foreach my $e (reverse(sort(keys %{ $sub }))) { my $key = $e; my $string = $sub->{$e}; my $quote = '"'; $string =~ s/^[\s]+//; $string =~ s/[\s]+$//; if ($string =~ /^'.*'$/) { $quote = "'"; } $string =~ s/^['"]//g; $string =~ s/['"]$//g; if ($do_translate && $key =~ /^_/) { $key =~ s|^_||g; if ($language) { # Handle translation my $decode_string = entity_decode($string); my $translation = $translations{$language, $decode_string}; if ($translation) { $translation = entity_encode($translation); $string = $translation; } $$translate = 2; } else { $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate } } $result .= " $key=$quote$string$quote"; } return $result; } # Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree sub getXMLstring { my $ref = shift; my $spacepreserve = shift || 0; my @list = @{ $ref }; my $result = ""; my $count = scalar(@list); my $attrs = $list[0]; my $index = 1; $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); while ($index < $count) { my $type = $list[$index]; my $content = $list[$index+1]; if (! $type ) { # We've got CDATA if ($content) { # lets strip the whitespace here, and *ONLY* here $content =~ s/\s+/ /gs if (!$spacepreserve); $result .= $content; } } elsif ( "$type" ne "1" ) { # We've got another element $result .= "<$type"; $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements if ($content) { my $subresult = getXMLstring($content, $spacepreserve); if ($subresult) { $result .= ">".$subresult . ""; } else { $result .= "/>"; } } else { $result .= "/>"; } } $index += 2; } return $result; } # Translate list of nodes if necessary sub translate_subnodes { my $fh = shift; my $content = shift; my $language = shift || ""; my $singlelang = shift || 0; my $spacepreserve = shift || 0; my @nodes = @{ $content }; my $count = scalar(@nodes); my $index = 0; while ($index < $count) { my $type = $nodes[$index]; my $rest = $nodes[$index+1]; if ($singlelang) { my $oldMO = $MULTIPLE_OUTPUT; $MULTIPLE_OUTPUT = 1; traverse($fh, $type, $rest, $language, $spacepreserve); $MULTIPLE_OUTPUT = $oldMO; } else { traverse($fh, $type, $rest, $language, $spacepreserve); } $index += 2; } } sub isWellFormedXmlFragment { my $ret = eval 'require XML::Parser'; if(!$ret) { die "You must have XML::Parser installed to run $0\n\n"; } my $fragment = shift; return 0 if (!$fragment); $fragment = "$fragment"; my $xp = new XML::Parser(Style => 'Tree'); my $tree = 0; eval { $tree = $xp->parse($fragment); }; return $tree; } sub traverse { my $fh = shift; my $nodename = shift; my $content = shift; my $language = shift || ""; my $spacepreserve = shift || 0; if (!$nodename) { if ($content =~ /^[\s]*$/) { $leading_space .= $content; } print $fh $content; } else { # element my @all = @{ $content }; my $attrs = shift @all; my $translate = 0; my $outattr = getAttributeString($attrs, 1, $language, \$translate); if ($nodename =~ /^_/) { $translate = 1; $nodename =~ s/^_//; } my $lookup = ''; $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/)); $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); print $fh "<$nodename", $outattr; if ($translate) { $lookup = getXMLstring($content, $spacepreserve); if (!$spacepreserve) { $lookup =~ s/^\s+//s; $lookup =~ s/\s+$//s; } if ($lookup || $translate == 2) { my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup}); if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) { $translation = $lookup if (!$translation); print $fh " xml:lang=\"", $language, "\"" if $language; print $fh ">"; if ($translate == 2) { translate_subnodes($fh, \@all, $language, 1, $spacepreserve); } else { print $fh $translation; } print $fh ""; return; # this means there will be no same translation with xml:lang="$language"... # if we want them both, just remove this "return" } else { print $fh ">"; if ($translate == 2) { translate_subnodes($fh, \@all, $language, 1, $spacepreserve); } else { print $fh $lookup; } print $fh ""; } } else { print $fh "/>"; } for my $lang (sort keys %po_files_by_lang) { if ($MULTIPLE_OUTPUT && $lang ne "$language") { next; } if ($lang) { # Handle translation # my $translate = 0; my $localattrs = getAttributeString($attrs, 1, $lang, \$translate); my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup}); if ($translate && !$translation) { $translation = $lookup; } if ($translation || $translate) { print $fh "\n"; $leading_space =~ s/.*\n//g; print $fh $leading_space; print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">"; if ($translate == 2) { translate_subnodes($fh, \@all, $lang, 1, $spacepreserve); } else { print $fh $translation; } print $fh ""; } } } } else { my $count = scalar(@all); if ($count > 0) { print $fh ">"; my $index = 0; while ($index < $count) { my $type = $all[$index]; my $rest = $all[$index+1]; traverse($fh, $type, $rest, $language, $spacepreserve); $index += 2; } print $fh ""; } else { print $fh "/>"; } } } } sub intltool_tree_comment { my $expat = shift; my $data = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; push @$clist, 1 => $data; } sub intltool_tree_cdatastart { my $expat = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; push @$clist, 0 => $expat->original_string(); } sub intltool_tree_cdataend { my $expat = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; $clist->[$pos] .= $expat->original_string(); } sub intltool_tree_char { my $expat = shift; my $text = shift; my $clist = $expat->{Curlist}; my $pos = $#$clist; # Use original_string so that we retain escaped entities # in CDATA sections. # if ($pos > 0 and $clist->[$pos - 1] eq '0') { $clist->[$pos] .= $expat->original_string(); } else { push @$clist, 0 => $expat->original_string(); } } sub intltool_tree_start { my $expat = shift; my $tag = shift; my @origlist = (); # Use original_string so that we retain escaped entities # in attribute values. We must convert the string to an # @origlist array to conform to the structure of the Tree # Style. # my @original_array = split /\x/, $expat->original_string(); my $source = $expat->original_string(); # Remove leading tag. # $source =~ s|^\s*<\s*(\S+)||s; # Grab attribute key/value pairs and push onto @origlist array. # while ($source) { if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/) { $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s; push @origlist, $1; push @origlist, '"' . $2 . '"'; } elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/) { $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s; push @origlist, $1; push @origlist, "'" . $2 . "'"; } else { last; } } my $ol = [ { @origlist } ]; push @{ $expat->{Lists} }, $expat->{Curlist}; push @{ $expat->{Curlist} }, $tag => $ol; $expat->{Curlist} = $ol; } sub readXml { my $filename = shift || return; if(!-f $filename) { die "ERROR Cannot find filename: $filename\n"; } my $ret = eval 'require XML::Parser'; if(!$ret) { die "You must have XML::Parser installed to run $0\n\n"; } my $xp = new XML::Parser(Style => 'Tree'); $xp->setHandlers(Char => \&intltool_tree_char); $xp->setHandlers(Start => \&intltool_tree_start); $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart); $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend); my $tree = $xp->parsefile($filename); # Hello thereHowdydo # would be: # [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]], bar, [{}, # 0, "Howdy", ref, [{}]], 0, "do" ] ] return $tree; } sub print_header { my $infile = shift; my $fh = shift; my $source; if(!-f $infile) { die "ERROR Cannot find filename: $infile\n"; } print $fh qq{\n}; { local $/; open DOCINPUT, "<${FILE}" or die; $source = ; close DOCINPUT; } if ($source =~ /()/s) { print $fh "$1\n"; } elsif ($source =~ /(]*>)/s) { print $fh "$1\n"; } } sub parseTree { my $fh = shift; my $ref = shift; my $language = shift || ""; my $name = shift @{ $ref }; my $cont = shift @{ $ref }; while (!$name || "$name" eq "1") { $name = shift @{ $ref }; $cont = shift @{ $ref }; } my $spacepreserve = 0; my $attrs = @{$cont}[0]; $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/)); traverse($fh, $name, $cont, $language, $spacepreserve); } sub xml_merge_output { my $source; if ($MULTIPLE_OUTPUT) { for my $lang (sort keys %po_files_by_lang) { if ( ! -e $lang ) { mkdir $lang or die "Cannot create subdirectory $lang: $!\n"; } open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n"; binmode (OUTPUT) if $^O eq 'MSWin32'; my $tree = readXml($FILE); print_header($FILE, \*OUTPUT); parseTree(\*OUTPUT, $tree, $lang); close OUTPUT; print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG; } } open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n"; binmode (OUTPUT) if $^O eq 'MSWin32'; my $tree = readXml($FILE); print_header($FILE, \*OUTPUT); parseTree(\*OUTPUT, $tree); close OUTPUT; print "CREATED $OUTFILE\n" unless $QUIET_ARG; } sub keys_merge_translations { open INPUT, "<${FILE}" or die; open OUTPUT, ">${OUTFILE}" or die; binmode (OUTPUT) if $^O eq 'MSWin32'; while () { if (s/^(\s*)_(\w+=(.*))/$1$2/) { my $string = $3; print OUTPUT; my $non_translated_line = $_; for my $lang (sort keys %po_files_by_lang) { my $translation = $translations{$lang, $string}; next if !$translation; $_ = $non_translated_line; s/(\w+)=.*/[$lang]$1=$translation/; print OUTPUT; } } else { print OUTPUT; } } close OUTPUT; close INPUT; } sub desktop_merge_translations { open INPUT, "<${FILE}" or die; open OUTPUT, ">${OUTFILE}" or die; binmode (OUTPUT) if $^O eq 'MSWin32'; while () { if (s/^(\s*)_(\w+=(.*))/$1$2/) { my $string = $3; print OUTPUT; my $non_translated_line = $_; for my $lang (sort keys %po_files_by_lang) { my $translation = $translations{$lang, $string}; next if !$translation; $_ = $non_translated_line; s/(\w+)=.*/${1}[$lang]=$translation/; print OUTPUT; } } else { print OUTPUT; } } close OUTPUT; close INPUT; } sub schemas_merge_translations { my $source; { local $/; # slurp mode open INPUT, "<$FILE" or die "can't open $FILE: $!"; $source = ; close INPUT; } open OUTPUT, ">$OUTFILE" or die; binmode (OUTPUT) if $^O eq 'MSWin32'; # FIXME: support attribute translations # Empty nodes never need translation, so unmark all of them. # For example, <_foo/> is just replaced by . $source =~ s|<\s*_($w+)\s*/>|<$1/>|g; while ($source =~ s/ (.*?) (\s+)((\s*) (\s*(?:\s*)?(.*?)\s*<\/default>)?(\s*) (\s*(?:\s*)?(.*?)\s*<\/short>)?(\s*) (\s*(?:\s*)?(.*?)\s*<\/long>)?(\s*) <\/locale>) //sx) { print OUTPUT $1; my $locale_start_spaces = $2 ? $2 : ''; my $default_spaces = $4 ? $4 : ''; my $short_spaces = $7 ? $7 : ''; my $long_spaces = $10 ? $10 : ''; my $locale_end_spaces = $13 ? $13 : ''; my $c_default_block = $3 ? $3 : ''; my $default_string = $6 ? $6 : ''; my $short_string = $9 ? $9 : ''; my $long_string = $12 ? $12 : ''; print OUTPUT "$locale_start_spaces$c_default_block"; $default_string =~ s/\s+/ /g; $default_string = entity_decode($default_string); $short_string =~ s/\s+/ /g; $short_string = entity_decode($short_string); $long_string =~ s/\s+/ /g; $long_string = entity_decode($long_string); for my $lang (sort keys %po_files_by_lang) { my $default_translation = $translations{$lang, $default_string}; my $short_translation = $translations{$lang, $short_string}; my $long_translation = $translations{$lang, $long_string}; next if (!$default_translation && !$short_translation && !$long_translation); print OUTPUT "\n$locale_start_spaces"; print OUTPUT "$default_spaces"; if ($default_translation) { $default_translation = entity_encode($default_translation); print OUTPUT "$default_translation"; } print OUTPUT "$short_spaces"; if ($short_translation) { $short_translation = entity_encode($short_translation); print OUTPUT "$short_translation"; } print OUTPUT "$long_spaces"; if ($long_translation) { $long_translation = entity_encode($long_translation); print OUTPUT "$long_translation"; } print OUTPUT "$locale_end_spaces"; } } print OUTPUT $source; close OUTPUT; } sub rfc822deb_merge_translations { my %encodings = (); for my $lang (keys %po_files_by_lang) { $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang})); } my $source; { local $/; # slurp mode open INPUT, "<$FILE" or die "can't open $FILE: $!"; $source = ; close INPUT; } open OUTPUT, ">${OUTFILE}" or die; binmode (OUTPUT) if $^O eq 'MSWin32'; my $last = 0; while ($source =~ /\G(.*?)(^|\n)(_+)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg) { $last = pos($source); my ($pre, $newline, $underscore, $tag, $space, $text) = ($1, $2, $3, $4, $5, $6); my $non_translated_line = $tag.$space; $underscore = length($underscore); # Print untranslated fields my $untranslated_fields = $pre; $untranslated_fields =~ s/\n#.*//g; $untranslated_fields =~ s/^#.*(\n|$)//; print OUTPUT $untranslated_fields; # Remove [] dummy strings my $stripped = $text; $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore == 2; $stripped =~ s/\[\s[^\[\]]*\]$//; $non_translated_line .= $stripped; print OUTPUT $newline.$non_translated_line; if ($underscore) { my @str_list = rfc822deb_split($underscore, $text); my $partial = 0; # Process pseudo-comments my @tfields = (); if ($pre =~ m/^#flag:/m) { my @c = split (/\n#flag:/, $pre); # The first field is null shift (@c); for (@c) { if (s/^comment(!?):(\S+)(?=\n|$)//s) { # This command is ignored by intltool-merge } elsif (s/^translate(!?):(\S+)(?=\n|$)//s) { rfc822deb_parse_spec($2, $1, 1+$#str_list, 0, 1, \@tfields); } elsif (s/^partial(?=\n|$)//s) { $partial = 1; } else { die "Unknown directive: $_\n\nAborting!\n"; } } } # By default, print all msgids rfc822deb_parse_spec('*', '', 1+$#str_list, 0, 1, \@tfields) if $#tfields == -1; for my $lang (sort keys %po_files_by_lang) { my $is_translated = 1; my $str_translated = ''; my $cnt = 0; for my $str (@str_list) { $cnt++; my $translation; if ($tfields[$cnt] && $str ne '') { $translation = $translations{$lang, $str}; if (!$translation) { if ($partial) { $translation = $str; } else { $is_translated = 0; last; } } } else { $translation = $str; } # $translation may also contain [] dummy # strings, mostly to indicate an empty string $translation =~ s/\[\s[^\[\]]*\]$//; # Escape commas $translation =~ s/,/\\,/g if $underscore == 2; if ($cnt == 1) { print STDERR "WARNING: $lang: spurious newline removed\n" if $translation =~ s/\n/ /g; $str_translated .= $translation; } else { if ($underscore == 2) { $str_translated .= ', ' . $translation; } else { $translation =~ s/\n/\n /g; $str_translated .= "\n ." unless $cnt == 2; $str_translated .= "\n " . $translation unless $str eq ''; } } } next unless $is_translated; $str_translated =~ s/\s+$//; $str_translated = ' '.$str_translated if length ($str_translated) && $str_translated !~ /^\n/s; $_ = $non_translated_line; s/^(\w+):\s*.*/$newline${1}-$lang.$encodings{$lang}:$str_translated/s; print OUTPUT; } } } my $tail = substr($source, $last); $tail .= "\n" unless $tail =~ m/\n$/s; $tail =~ s/^#.*\n//mg; print OUTPUT $tail; close OUTPUT; close INPUT; } sub rfc822deb_parse_spec { my $spec = shift; my $negate = shift; my $len = shift; my $notfound = shift; my $found = shift; my $ref = shift; $spec = ','.$spec.','; # Replace '*' by all values my $all = '1-'.$len; $spec =~ s/\*/$all/g; # Expand ranges $spec =~ s/(\d+)-(\d+)/join(",", ($1..$2))/eg; if ($#{$ref} == -1) { for my $cnt (1..$len) { $ref->[$cnt] = $notfound; } } for my $cnt (1..$len) { if ($spec =~ m/,$cnt,/ && !$negate) { $ref->[$cnt] .= $found; } elsif ($spec !~ m/,$cnt,/ && $negate) { $ref->[$cnt] .= $found; } } } sub rfc822deb_split { # Debian defines a special way to deal with rfc822-style files: # when a value contain newlines, it consists of # 1. a short form (first line) # 2. a long description, all lines begin with a space, # and paragraphs are separated by a single dot on a line # This routine returns an array of all paragraphs, and reformat # them. # When first argument is 2, the string is a comma separated list of # values. my $type = shift; my $text = shift; $text =~ s/^[ \t]//mg; if ($type ne 1) { my @values = (); for my $value (split(/(?$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n"; binmode (OUTPUT) if $^O eq 'MSWin32'; while () { s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . "ed_translation($lang, $1) . "\""/ge; print OUTPUT; } close OUTPUT; close INPUT; } }