Unfinished utility for extracting to-be-translated strings from all the game's data files

This was SVN commit r1142.

source/tools/i18n/StringExtract/CCode.pm

@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+package StringExtract::CCode;
+
+use StringExtract::Utils;
+
+use Regexp::Common qw(delimited comment);
+
+our $data = {
+
+	file_roots => [
+		'source',
+	],
+	# TO DO:
+	# Limit the extent of the search, so it doesn't check e.g. the i18n test system
+
+	file_types => qr/\.(?:cpp|h)$/i,
+
+	readfile_func => sub { extract(StringExtract::Utils::read_text(@_)); },
+};
+
+sub extract {
+	my ($data) = @_;
+
+	$data =~ s/$RE{comment}{'C++'}//g;
+
+	my @strings;
+
+	while ($data =~ /translate\s*\(\s*L\s*($RE{delimited}{-delim=>'"'})\s*\)/g) {
+		my $str = $1;
+		# Remove surrounding quotes
+		$str =~ s/^"(.*)"$/$1/;
+		# Translate \" sequences
+		$str =~ s/\\"/"/g;
+		# and \n
+		$str =~ s/\\n/\n/g;
+		# and \\
+		$str =~ s/\\\\/\\/g;
+
+		push @strings, [ $1, "C++ code" ];
+	}
+
+	return @strings;
+}
+
+1;

source/tools/i18n/StringExtract/JSCode.pm

@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+package StringExtract::JSCode;
+
+use StringExtract::Utils;
+
+use Regexp::Common qw(delimited comment);
+
+our $data = {
+
+	file_roots => [
+		'binaries/data/mods/official/gui',
+	],
+
+	file_types => qr/\.js$/i,
+
+	readfile_func => sub { extract(StringExtract::Utils::read_text(@_)); },
+};
+
+sub extract {
+	my ($data) = @_;
+
+	$data =~ s/$RE{comment}{Java}//g;
+
+	my @strings;
+
+	while ($data =~ /translate\s*\(\s*($RE{delimited}{-delim=>'"'})/g) {
+		my $str = $1;
+		# Remove surrounding quotes
+		$str =~ s/^"(.*)"$/$1/;
+		# Translate \" sequences
+		$str =~ s/\\"/"/g;
+		# and \n
+		$str =~ s/\\n/\n/g;
+		# and \\
+		$str =~ s/\\\\/\\/g;
+
+		push @strings, [ $1, "GUI script" ];
+	}
+
+	return @strings;
+}
+
+1;

source/tools/i18n/StringExtract/Utils.pm

@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+
+package StringExtract::Utils;
+
+use XML::Simple();
+
+sub read_xml {
+	my ($filename) = $_;
+
+	my $xml = new XML::Simple(ForceArray=>1, KeepRoot=>1, KeyAttr=>[], ForceContent=>1);
+
+	my $data = $xml->XMLin($filename);
+	recursive_process($data);
+	
+	my $root = (keys %$data)[0];
+	return [ $root, @{$data->{$root}} ];
+}
+
+sub recursive_process {
+	if (ref($_[0]) eq 'HASH') {
+
+		# Force keys to lowercase
+		my %temp;
+		@temp{map lc, keys %{$_[0]}} = values %{$_[0]};
+		%{$_[0]} = %temp;
+		
+		# Trim whitespace in content
+		$_[0]{content} =~ s/^\s*(.*?)\s*$/$1/s if exists $_[0]{content};
+		
+		# Recurse through sub-elements
+		recursive_process($_) for values %{$_[0]};
+
+	} elsif (ref($_[0]) eq 'ARRAY') {
+
+		# Recurse through sub-elements
+		recursive_process($_) for @{$_[0]};
+	}
+}
+
+
+sub read_text {
+	my ($filename) = $_;
+
+	open my $file, '<', $filename or die "Error opening $filename: $!";
+	my $data = do { local $/; <$file> };
+
+	return $data;
+}
+
+
+1;

source/tools/i18n/StringExtract/XML.pm

@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+package StringExtract::XML;
+
+use StringExtract::Utils;
+use StringExtract::JSCode;
+
+our $data = {
+
+	file_roots => [
+		'binaries/data/mods/official/art',
+		'binaries/data/mods/official/entities',
+		'binaries/data/mods/official/gui',
+	],
+
+	file_types => qr/\.xml$/i,
+
+	readfile_func => sub { extract(StringExtract::Utils::read_xml(@_)); },
+};
+
+sub extract {
+	my ($xmldata) = @_;
+	my ($root, %elements) = ($xmldata->[0], %{$xmldata->[1]});
+
+	my @strings;
+
+	# Entities
+	if ($root eq 'entity') {
+
+		push @strings, map [ $_->{content}, "Entity name" ], @{$elements{name}};
+
+	# Actors
+	} elsif ($root eq 'object') {
+
+		push @strings, map [ $_->{content}, "Actor name" ], @{$elements{name}};
+
+	# GUI objects
+	} elsif ($root eq 'objects') {
+
+		recursive_extract_guiobject(\@strings, [\%elements]);#$elements{object});
+
+	# GUI setup
+	} elsif ($root eq 'setup') {
+		# Do nothing
+
+	# GUI sprites
+	} elsif ($root eq 'sprites') {
+		# Do nothing
+
+	# GUI styles
+	} elsif ($root eq 'styles') {
+		# Do nothing
+
+	} else {
+		die "Unrecognised XML file type '$root'";
+	}
+	return @strings;
+
+}
+
+sub recursive_extract_guiobject {
+	my ($strings, $elements) = @_;
+	for my $element (@$elements) {
+		push @$strings, [ $element->{tooltip}, "GUI tooltip" ] if defined $element->{tooltip};
+		push @$strings, [ $element->{content}, "GUI text"    ] if defined $element->{content};
+
+		if ($element->{script}) {
+			push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{script}};
+		}
+		if ($element->{action}) {
+			push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{action}};
+		}
+
+		recursive_extract_guiobject($strings, $element->{object}) if $element->{object};
+	}
+}
+
+1;

source/tools/i18n/stringextract.pl

@@ -0,0 +1,43 @@
+=pod
+
+String extraction utility
+
+
+=cut
+
+use strict;
+use warnings;
+
+use File::Find;
+
+
+use StringExtract::XML;
+use StringExtract::JSCode;
+use StringExtract::CCode;
+
+my %all_strings;
+
+for my $type (
+	$StringExtract::XML::data,
+	$StringExtract::JSCode::data,
+	$StringExtract::CCode::data,
+) {
+
+	# Get the list of files that the module wants to handle
+	my @files;
+	find(sub {
+		push @files, $File::Find::name if /$type->{file_types}/;
+	}, map "../../../$_", @{$type->{file_roots}});
+
+#@files=@files[0..2];
+	
+	my @strings = map $type->{readfile_func}->($_), @files;
+
+	for (@strings) {
+		$all_strings{$_->[0]} ||= [];
+		push @{$all_strings{$_->[0]}}, $_->[1];
+	}
+}
+
+use Data::Dumper; print join "\n", map join(' :: ', $_, @{$all_strings{$_}}), sort keys %all_strings;
+#print join ", ", keys %all_strings;