📄 intltool-merge
字号:
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);
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
# 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{<?xml version="1.0" encoding="UTF-8"?>\n};
{
local $/;
open DOCINPUT, "<${FILE}" or die;
$source = <DOCINPUT>;
close DOCINPUT;
}
if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
{
print $fh "$1\n";
}
elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
{
print $fh "$1\n";
}
}
sub parseTree
{
my $fh = shift;
my $ref = shift;
my $language = shift || "";
my $name = shift @{ $ref };
my $cont = shift @{ $ref };
traverse($fh, $name, $cont, $language);
}
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";
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";
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;
while (<INPUT>)
{
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;
while (<INPUT>)
{
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 = <INPUT>;
close INPUT;
}
open OUTPUT, ">$OUTFILE" or die;
# FIXME: support attribute translations
# Empty nodes never need translation, so unmark all of them.
# For example, <_foo/> is just replaced by <foo/>.
$source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
while ($source =~ s/
(.*?)
(\s+)(<locale\ name="C">(\s*)
(<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
(<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
(<long>\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<locale name=\"$lang\">";
print OUTPUT "$default_spaces";
if ($default_translation)
{
$default_translation = entity_encode($default_translation);
print OUTPUT "<default>$default_translation</default>";
}
print OUTPUT "$short_spaces";
if ($short_translation)
{
$short_translation = entity_encode($short_translation);
print OUTPUT "<short>$short_translation</short>";
}
print OUTPUT "$long_spaces";
if ($long_translation)
{
$long_translation = entity_encode($long_translation);
print OUTPUT "<long>$long_translation</long>";
}
print OUTPUT "$locale_end_spaces</locale>";
}
}
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;
$Text::Wrap::huge = 'overflow';
$Text::Wrap::break = qr/\n|\s(?=\S)/;
{
local $/; # slurp mode
open INPUT, "<$FILE" or die "can't open $FILE: $!";
$source = <INPUT>;
close INPUT;
}
open OUTPUT, ">${OUTFILE}" or die;
while ($source =~ /(^|\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;
print OUTPUT $sep.$non_translated_line;
if ($underscore)
{
my @str_list = rfc822deb_split($underscore, $string);
for my $lang (sort keys %po_files_by_lang)
{
my $is_translated = 1;
my $str_translated = '';
my $first = 1;
for my $str (@str_list)
{
my $translation = $translations{$lang, $str};
if (!$translation)
{
$is_translated = 0;
last;
}
# $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
{
if ($underscore eq 2)
{
$str_translated .= ', ' . $translation;
}
else
{
$str_translated .= Text::Tabs::expand(
Text::Wrap::wrap(' ', ' ', $translation)) .
"\n .\n";
}
}
$first = 0;
# To fix some problems with Text::Wrap::wrap
$str_translated =~ s/(\n )+\n/\n .\n/g;
}
next unless $is_translated;
$str_translated =~ s/\n \.\n$//;
$str_translated =~ s/\s+$//;
$_ = $non_translated_line;
s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
print OUTPUT;
}
}
}
print OUTPUT "\n";
close OUTPUT;
close INPUT;
}
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;
return (split(/, */, $text, 0)) if $type ne 1;
return ($text) if $text !~ /\n/;
$text =~ s/([^\n]*)\n//;
my @list = ($1);
my $str = '';
for my $line (split (/\n/, $text))
{
chomp $line;
if ($line =~ /^\.\s*$/)
{
# New paragraph
$str =~ s/\s*$//;
push(@list, $str);
$str = '';
}
elsif ($line =~ /^\s/)
{
# Line which must not be reformatted
$str .= "\n" if length ($str) && $str !~ /\n$/;
$line =~ s/\s+$//;
$str .= $line."\n";
}
else
{
# Continuation line, remove newline
$str .= " " if length ($str) && $str !~ /\n$/;
$str .= $line;
}
}
$str =~ s/\s*$//;
push(@list, $str) if length ($str);
return @list;
}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -