Uninteresting things that I've had hanging around for a while.
This was SVN commit r2190.
This commit is contained in:
parent
780b6e266b
commit
0fc17f7305
Binary file not shown.
@ -63,7 +63,7 @@ sub unescape {
|
||||
}
|
||||
sub escape {
|
||||
my $t = $_[0];
|
||||
return "\\" unless length $t;
|
||||
return "\\" unless defined $t and length $t;
|
||||
$t =~ s/\\/\\\\/g;
|
||||
$t =~ s/\n/\\n/g;
|
||||
$t;
|
||||
|
@ -14,7 +14,6 @@ our $data = {
|
||||
],
|
||||
|
||||
file_roots_ignore => [
|
||||
'source/workspaces',
|
||||
'source/i18n/tests',
|
||||
'source/tools',
|
||||
],
|
||||
|
@ -4,6 +4,7 @@ use warnings;
|
||||
package StringExtract::Utils;
|
||||
|
||||
use XML::Simple();
|
||||
use Carp;
|
||||
|
||||
use Regexp::Common qw(comment);
|
||||
|
||||
@ -18,14 +19,24 @@ sub read_xml {
|
||||
);
|
||||
|
||||
my $filedata = do { open my $f, '<', $filename or die $!; local $/; <$f> };
|
||||
my ($dir) = ($filename =~ /(.*)[\\\/]/);
|
||||
|
||||
# Fix DTD paths
|
||||
my ($dir) = ($filename =~ m~(.*)[\\/]~);
|
||||
$filedata =~ s {SYSTEM "(?!/)} {SYSTEM "$dir/};
|
||||
$filedata =~ s {SYSTEM "/} {SYSTEM "../../../binaries/data/mods/official/};
|
||||
my $data = $xml->XMLin($filedata);
|
||||
|
||||
my $data = eval { $xml->XMLin($filedata) };
|
||||
|
||||
if ($@) {
|
||||
warn "Error reading $filename: $@";
|
||||
return;
|
||||
}
|
||||
recursive_process($data);
|
||||
|
||||
my ($filename_short) = ($filename =~ m~([^\\/]+)$~);
|
||||
|
||||
my $root = (keys %$data)[0];
|
||||
return [ $root, @{$data->{$root}} ];
|
||||
return [ $root, $filename_short, @{$data->{$root}} ];
|
||||
}
|
||||
|
||||
sub recursive_process {
|
||||
@ -53,7 +64,7 @@ sub recursive_process {
|
||||
sub read_text {
|
||||
my ($filename) = $_;
|
||||
|
||||
open my $file, '<', $filename or die "Error opening $filename: $!";
|
||||
open my $file, '<', $filename or carp "Error opening $filename: $!";
|
||||
my $data = do { local $/; <$file> };
|
||||
|
||||
return ({ filename => $filename }, $data);
|
||||
|
@ -21,24 +21,29 @@ our $data = {
|
||||
|
||||
sub extract {
|
||||
my ($xmldata) = @_;
|
||||
my ($root, %elements) = ($xmldata->[0], %{$xmldata->[1]});
|
||||
return unless $xmldata;
|
||||
|
||||
my ($root, $filename, %elements) = (@{$xmldata}[0, 1], %{$xmldata->[2]});
|
||||
|
||||
my @strings;
|
||||
|
||||
# Entities
|
||||
if ($root eq 'entity') {
|
||||
|
||||
push @strings, map [ "noun:".$_->{content}, "Entity name" ], @{$elements{name}};
|
||||
push @strings, map [ "noun:".$_->{content}, "Entity name ($filename)" ], @{$elements{name}};
|
||||
|
||||
# Actors
|
||||
} elsif ($root eq 'object') {
|
||||
|
||||
push @strings, map [ "noun:".$_->{content}, "Actor name" ], @{$elements{name}};
|
||||
push @strings, map [ "noun:".$_->{content}, "Actor name ($filename)" ], @{$elements{name}};
|
||||
|
||||
# Materials
|
||||
} elsif ($root eq 'material') {
|
||||
|
||||
# GUI objects
|
||||
} elsif ($root eq 'objects') {
|
||||
|
||||
recursive_extract_guiobject(\@strings, [\%elements]);
|
||||
recursive_extract_guiobject($filename, \@strings, [\%elements]);
|
||||
|
||||
# GUI setup
|
||||
} elsif ($root eq 'setup') {
|
||||
@ -60,10 +65,10 @@ sub extract {
|
||||
}
|
||||
|
||||
sub recursive_extract_guiobject {
|
||||
my ($strings, $elements) = @_;
|
||||
my ($filename, $strings, $elements) = @_;
|
||||
for my $element (@$elements) {
|
||||
push @$strings, [ "phrase:".$element->{tooltip}, "GUI tooltip" ] if defined $element->{tooltip};
|
||||
push @$strings, [ "phrase:".$element->{content}, "GUI text" ] if defined $element->{content};
|
||||
push @$strings, [ "phrase:".$element->{tooltip}, "GUI tooltip ($filename)" ] if defined $element->{tooltip};
|
||||
push @$strings, [ "phrase:".$element->{content}, "GUI text ($filename)" ] if defined $element->{content};
|
||||
|
||||
if ($element->{script}) {
|
||||
push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{script}};
|
||||
@ -72,7 +77,7 @@ sub recursive_extract_guiobject {
|
||||
push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{action}};
|
||||
}
|
||||
|
||||
recursive_extract_guiobject($strings, $element->{object}) if $element->{object};
|
||||
recursive_extract_guiobject($filename, $strings, $element->{object}) if $element->{object};
|
||||
}
|
||||
}
|
||||
|
||||
|
61
source/tools/i18n/Strings.pm
Normal file
61
source/tools/i18n/Strings.pm
Normal file
@ -0,0 +1,61 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Strings;
|
||||
|
||||
use DataFiles;
|
||||
|
||||
sub merge {
|
||||
my ($filename, %new_strings) = @_;
|
||||
|
||||
# Read the earlier string data
|
||||
my $strings = DataFiles::read_file($filename, ignoremissing=>1);
|
||||
|
||||
for my $old (@$strings) {
|
||||
my $stringid = $old->[STR_ID];
|
||||
|
||||
if (exists $new_strings{$stringid}) {
|
||||
# String already exists; just update the content
|
||||
if ($new_strings{$stringid}{context}) {
|
||||
$old->[STR_CONTEXT] = $new_strings{$stringid}{context};
|
||||
}
|
||||
if ($new_strings{$stringid}{description}) {
|
||||
$old->[STR_DESCRIPTION] = $new_strings{$stringid}{description};
|
||||
}
|
||||
|
||||
# Make sure it's not obsolete now
|
||||
flag_set(\$old->[STR_FLAGS], 'obsolete', 0);
|
||||
|
||||
# Remove it from this list, so the unprocessed ones can be found later
|
||||
delete $new_strings{$stringid};
|
||||
|
||||
} else {
|
||||
# String has been removed; set obsolete flag
|
||||
flag_set(\$old->[STR_FLAGS], 'obsolete', 1);
|
||||
}
|
||||
}
|
||||
|
||||
for (keys %new_strings) {
|
||||
# Newly added strings
|
||||
push @$strings, [ $_, len_or($new_strings{$_}{context}, "?"), len_or($new_strings{$_}{description}, "?"), "" ];
|
||||
}
|
||||
|
||||
DataFiles::write_file($filename, $strings);
|
||||
}
|
||||
|
||||
sub len_or { (defined $_[0] and length $_[0]) ? $_[0] : $_[1] }
|
||||
|
||||
|
||||
sub flag_set {
|
||||
my ($str, $flagname, $value) = @_;
|
||||
my @flags = split / /, $$str;
|
||||
if ($value) {
|
||||
push @flags, $flagname unless grep $_ eq $flagname, @flags;
|
||||
} else {
|
||||
@flags = grep $_ ne $flagname, @flags;
|
||||
}
|
||||
$$str = join ' ', @flags;
|
||||
}
|
||||
|
||||
|
||||
1;
|
40
source/tools/i18n/Translations.pm
Normal file
40
source/tools/i18n/Translations.pm
Normal file
@ -0,0 +1,40 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Translations;
|
||||
|
||||
use DataFiles;
|
||||
|
||||
sub merge {
|
||||
my ($filename, %new_translations) = @_;
|
||||
|
||||
# Read the earlier translation data
|
||||
my $translations = DataFiles::read_file($filename, ignoremissing=>1);
|
||||
|
||||
for my $old (@$translations) {
|
||||
my $stringid = $old->[0];
|
||||
|
||||
if (exists $new_translations{$stringid}) {
|
||||
# Translation already exists; just update the content
|
||||
$old->[1] = $new_translations{$stringid};
|
||||
|
||||
# Remove it from this list, so the unprocessed ones can be found later
|
||||
delete $new_translations{$stringid};
|
||||
|
||||
} else {
|
||||
# String has been removed; leave it for now
|
||||
}
|
||||
}
|
||||
|
||||
for (keys %new_translations) {
|
||||
# Newly added translations
|
||||
push @$translations, [ $_, len_or($new_translations{$_}, "") ];
|
||||
}
|
||||
|
||||
DataFiles::write_file($filename, $translations);
|
||||
}
|
||||
|
||||
sub len_or { (defined $_[0] and length $_[0]) ? $_[0] : $_[1] }
|
||||
|
||||
|
||||
1;
|
@ -7,6 +7,8 @@ our %config;
|
||||
do "config.pl";
|
||||
|
||||
use DataFiles;
|
||||
use Strings;
|
||||
use Translations;
|
||||
|
||||
use Spreadsheet::ParseExcel;
|
||||
|
||||
@ -14,32 +16,42 @@ fromspreadsheet($config{strings_filename}, $config{data_path}."/$language/transl
|
||||
|
||||
sub fromspreadsheet {
|
||||
my ($strings_filename, $translations_filename, $spreadsheet_filename) = @_;
|
||||
|
||||
# Read data from spreadsheet:
|
||||
|
||||
my $strings = DataFiles::read_file($strings_filename);
|
||||
my $translations = DataFiles::read_file($translations_filename, ignoremissing=>1);
|
||||
|
||||
my $workbook = Spreadsheet::ParseExcel::Workbook->Parse($spreadsheet_filename);
|
||||
|
||||
my @stringdata; # = ( [type:id, description], ...)
|
||||
my @transdata; # = ( [type:id, translation], ...)
|
||||
my %strings; # Data associated with each string. (type:id => { description => '...' }, ...)
|
||||
my %translations; # Data associated with each translation. (type:id => translation, ...)
|
||||
|
||||
for my $worksheet (@{$workbook->{Worksheet}}) {
|
||||
my $type = $worksheet->{Name};
|
||||
|
||||
my @rows;
|
||||
for my $col ($worksheet->{MinCol} .. $worksheet->{MaxCol}) {
|
||||
push @cells, [];
|
||||
for my $row ($worksheet->{MinRow} .. $worksheet->{MaxRow}) {
|
||||
for my $row ($worksheet->{MinRow} .. $worksheet->{MaxRow}) {
|
||||
next if $row == 0;
|
||||
push @rows, [];
|
||||
for my $col ($worksheet->{MinCol} .. $worksheet->{MaxCol}) {
|
||||
push @{$rows[-1]}, $worksheet->{Cells}[$row][$col]->{Val};
|
||||
}
|
||||
}
|
||||
|
||||
for (@rows) {
|
||||
my $id = $type.':'.$_->[0];
|
||||
push @transsdata, [$id, $_->[1]];
|
||||
push @stringsdata, [$id, $_->[2]];
|
||||
|
||||
if ($strings{$id}) {
|
||||
warn "Duplicated string $id!";
|
||||
}
|
||||
$strings{$id} = { description => $_->[2] };
|
||||
$translations{$id} = $_->[1];
|
||||
}
|
||||
}
|
||||
|
||||
Strings::merge($strings_filename, %strings);
|
||||
|
||||
|
||||
Translations::merge($translations_filename, %translations);
|
||||
|
||||
}
|
||||
|
@ -19,14 +19,15 @@ use StringExtract::JSCode;
|
||||
use StringExtract::CCode;
|
||||
|
||||
use DataFiles;
|
||||
use Strings;
|
||||
|
||||
my %all_strings;
|
||||
|
||||
# Repeat for each data type that needs to be parsed
|
||||
for my $type (
|
||||
# $StringExtract::XML::data,
|
||||
$StringExtract::XML::data,
|
||||
# $StringExtract::JSCode::data,
|
||||
$StringExtract::CCode::data,
|
||||
# $StringExtract::CCode::data,
|
||||
) {
|
||||
|
||||
# Get the list of files that the module wants to handle
|
||||
@ -38,8 +39,10 @@ for my $type (
|
||||
my @dirs = map $prefix.$_, @{$type->{file_roots}};
|
||||
find({
|
||||
preprocess => sub {
|
||||
# Trim the ../../../ prefix
|
||||
my $path = substr($File::Find::dir, length $prefix);
|
||||
grep !contains($type->{file_roots_ignore}, $path.'/'.$_), @_;
|
||||
# Ignore all directories that are called '.svn', or whose paths are any of file_roots_ignore
|
||||
grep not ($_ eq '.svn' or contains($type->{file_roots_ignore}, $path.'/'.$_)), @_;
|
||||
},
|
||||
wanted => sub {
|
||||
# Include files that match the file_types regexp
|
||||
@ -64,52 +67,18 @@ for my $type (
|
||||
}
|
||||
}
|
||||
|
||||
# Transform into %all_strings = (stringid => { context => '...' })
|
||||
for (keys %all_strings) {
|
||||
$all_strings{$_} = { context => join "\n", uniq(sort @{$all_strings{$_}}) };
|
||||
}
|
||||
|
||||
# Merge the string data with any existing information
|
||||
merge_strings($config{strings_filename}, %all_strings);
|
||||
Strings::merge($config{strings_filename}, %all_strings);
|
||||
|
||||
sub merge_strings {
|
||||
my ($filename, %new_strings) = @_;
|
||||
|
||||
# Read the earlier string data
|
||||
my $strings = DataFiles::read_file($filename, ignoremissing=>1);
|
||||
|
||||
for my $old (@$strings) {
|
||||
my $stringid = $old->[STR_ID];
|
||||
|
||||
if ($new_strings{$stringid}) {
|
||||
# String already exists; just update the context
|
||||
$old->[STR_CONTEXT] = join "\n", @{ $new_strings{$stringid} };
|
||||
sub contains { $_[1] eq $_ && return 1 for @{$_[0]}; 0 }
|
||||
|
||||
# Make sure it's not obsolete now
|
||||
flag_set(\$old->[STR_FLAGS], 'obsolete', 0);
|
||||
|
||||
# Remove it from this list, so the unprocessed ones can be found later
|
||||
delete $new_strings{$stringid};
|
||||
|
||||
} else {
|
||||
# String has been removed; set obsolete flag
|
||||
flag_set(\$old->[STR_FLAGS], 'obsolete', 1);
|
||||
}
|
||||
}
|
||||
|
||||
for (keys %new_strings) {
|
||||
# Newly added strings
|
||||
push @$strings, [ $_, join("\n", @{ $new_strings{$_} }), "?", "" ];
|
||||
}
|
||||
|
||||
DataFiles::write_file($filename, $strings);
|
||||
}
|
||||
|
||||
|
||||
sub flag_set {
|
||||
my ($str, $flagname, $value) = @_;
|
||||
my @flags = split / /, $$str;
|
||||
if ($value) {
|
||||
push @flags, $flagname unless grep $_ eq $flagname, @flags;
|
||||
} else {
|
||||
@flags = grep $_ ne $flagname, @flags;
|
||||
}
|
||||
$$str = join ' ', @flags;
|
||||
}
|
||||
|
||||
sub contains { $_[1] eq $_ && return 1 for @{$_[0]}; 0 }
|
||||
sub uniq { # Uniquify sorted lists
|
||||
my @r;
|
||||
for (@_) { push @r, $_ unless @r and $r[-1] eq $_ };
|
||||
@r;
|
||||
}
|
@ -16,14 +16,14 @@ sub tospreadsheet {
|
||||
my ($strings_filename, $translations_filename, $spreadsheet_filename) = @_;
|
||||
|
||||
my $strings = DataFiles::read_file($strings_filename);
|
||||
my $translations = DataFiles::read_file($translations_filename, ignoremissing=>1);
|
||||
my %translations = map @$_, DataFiles::read_file($translations_filename, ignoremissing=>1);
|
||||
|
||||
my %data; # = ("phrase" => [ [id, translation, description, context, flags ], ... ], "noun" => ...)
|
||||
|
||||
for my $string (@$strings) {
|
||||
my ($type, $id) = split /:/, $string->[STR_ID], 2;
|
||||
|
||||
my $translation = find_translation($translations, $string->[STR_ID]);
|
||||
my $translation = $translations{$string->[STR_ID]};
|
||||
|
||||
push @{$data{$type}}, [ $id, $translation, @$string[STR_DESCRIPTION, STR_CONTEXT, STR_FLAGS] ];
|
||||
}
|
||||
@ -34,7 +34,26 @@ sub tospreadsheet {
|
||||
|
||||
my $worksheet = $workbook->add_worksheet($type);
|
||||
|
||||
my $row = 0;
|
||||
my $headerformat = $workbook->add_format();
|
||||
$headerformat->set_bold(1);
|
||||
|
||||
$worksheet->write(0,0, "String", $headerformat);
|
||||
$worksheet->write(0,1, "Translation", $headerformat);
|
||||
$worksheet->write(0,2, "Description", $headerformat);
|
||||
$worksheet->write(0,3, "Used by", $headerformat);
|
||||
|
||||
$worksheet->freeze_panes(1, 0);
|
||||
|
||||
my $mainformat = $workbook->add_format();
|
||||
$mainformat->set_align('top');
|
||||
$mainformat->set_text_wrap();
|
||||
|
||||
$worksheet->set_column(0,0, 27, $mainformat);
|
||||
$worksheet->set_column(1,1, 45, $mainformat);
|
||||
$worksheet->set_column(2,2, 33, $mainformat);
|
||||
$worksheet->set_column(3,3, 33, $mainformat);
|
||||
|
||||
my $row = 1;
|
||||
|
||||
for my $string (@{ $data{$type} }) {
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user