You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
573 lines
17 KiB
573 lines
17 KiB
package AN::Tools::Words; |
|
# |
|
# This module contains methods used to handle storage related tasks |
|
# |
|
|
|
use strict; |
|
use warnings; |
|
use Data::Dumper; |
|
use XML::Simple qw(:strict); |
|
|
|
our $VERSION = "3.0.0"; |
|
my $THIS_FILE = "Words.pm"; |
|
|
|
# Setup for UTF-8 mode. |
|
# use utf8; |
|
# $ENV{'PERL_UNICODE'} = 1; |
|
|
|
### Methods; |
|
# clean_spaces |
|
# key |
|
# language |
|
# read |
|
# string |
|
|
|
=pod |
|
|
|
=encoding utf8 |
|
|
|
=head1 NAME |
|
|
|
AN::Tools::Words |
|
|
|
Provides all methods related to generating translated strings for users. |
|
|
|
=head1 SYNOPSIS |
|
|
|
use AN::Tools; |
|
|
|
# Get a common object handle on all AN::Tools modules. |
|
my $an = AN::Tools->new(); |
|
|
|
# Access to methods using '$an->Words->X'. |
|
# |
|
# Example using 'read()'; |
|
my $foo_path = $an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}); |
|
|
|
=head1 METHODS |
|
|
|
Methods in this module; |
|
|
|
=cut |
|
sub new |
|
{ |
|
my $class = shift; |
|
my $self = { |
|
WORDS => { |
|
LANGUAGE => "", |
|
}, |
|
}; |
|
|
|
bless $self, $class; |
|
|
|
return ($self); |
|
} |
|
|
|
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more |
|
# sense in this case to think of it as a parent. |
|
sub parent |
|
{ |
|
my $self = shift; |
|
my $parent = shift; |
|
|
|
$self->{HANDLE}{TOOLS} = $parent if $parent; |
|
|
|
return ($self->{HANDLE}{TOOLS}); |
|
} |
|
|
|
|
|
############################################################################################################# |
|
# Public methods # |
|
############################################################################################################# |
|
|
|
=head2 clean_spaces |
|
|
|
This methid takes a string via a 'C<< line >>' parameter and strips leading and trailing spaces, plus compresses multiple spaces into single spaces. It is designed primarily for use by code parsing text coming in from a shell command. |
|
|
|
my $line = $an->Words->clean_spaces({ string => $_ }); |
|
|
|
Parameters; |
|
|
|
=head3 string (required) |
|
|
|
This sets the string to be cleaned. If it is not passed in, or if the string is empty, then an empty string will be returned without error. |
|
|
|
=cut |
|
sub clean_spaces |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $string = defined $parameter->{string} ? $parameter->{string} : ""; |
|
$string =~ s/^\s+//; |
|
$string =~ s/\s+$//; |
|
$string =~ s/\s+/ /g; |
|
|
|
return($string); |
|
} |
|
|
|
=head2 key |
|
|
|
NOTE: This is likely not the method you want. This method does no parsing at all. It returns the raw string from the 'words' file. You probably want C<< $an->Words->string() >> if you want to inject variables and get a string back ready to display to the user. |
|
|
|
This returns a string by its key name. Optionally, a language and/or a source file can be specified. When no file is specified, loaded files will be search in alphabetical order (including path) and the first match is returned. |
|
|
|
If the requested string is not found, 'C<< #!not_found!# >>' is returned. |
|
|
|
Example to retrieve 'C<< t_0001 >>'; |
|
|
|
my $string = $an->Words->key({key => 't_0001'}); |
|
|
|
Same, but specifying the key from Canadian english; |
|
|
|
my $string = $an->Words->key({ |
|
key => 't_0001', |
|
language => 'en_CA', |
|
}); |
|
|
|
Same, but specifying a source file. |
|
|
|
my $string = $an->Words->key({ |
|
key => 't_0001', |
|
language => 'en_CA', |
|
file => 'an-tools.xml', |
|
}); |
|
|
|
Parameters; |
|
|
|
=head3 file (optional) |
|
|
|
This is the specific file to read the string from. It should generally not be needed as string keys should not be reused. However, if it happens, this is a way to specify which file's version you want. |
|
|
|
The file can be the file name, or a path. The specified file is search for by matching the the passed in string against the end of the file path. For example, 'C<< file => 'AN/an-tools.xml' >> will match the file 'c<< /usr/share/perl5/AN/an-tools.xml >>'. |
|
|
|
=head3 key (required) |
|
|
|
This is the key to return the string for. |
|
|
|
=head3 language (optional) |
|
|
|
This is the ISO code for the language you wish to read. For example, 'en_CA' to get the Canadian English string, or 'jp' for the Japanese string. |
|
|
|
When no language is passed, 'C<< Words->language >>' is used. |
|
|
|
=cut |
|
sub key |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $key = defined $parameter->{key} ? $parameter->{key} : ""; |
|
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Words->language; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
my $string = "#!not_found!#"; |
|
my $error = 0; |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - key: [$key], language: [$language], file: [$file]\n"; |
|
|
|
if (not $key) |
|
{ |
|
#print $THIS_FILE." ".__LINE__."; AN::Tools::Words->key()' called without a key name to read.\n"; |
|
$error = 1; |
|
} |
|
if (not $language) |
|
{ |
|
#print $THIS_FILE." ".__LINE__."; AN::Tools::Words->key()' called without a language, and 'defaults::languages::output' is not set.\n"; |
|
$error = 2; |
|
} |
|
|
|
if (not $error) |
|
{ |
|
foreach my $this_file (sort {$a cmp $b} keys %{$an->data->{words}}) |
|
{ |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - this_file: [$this_file], file: [$file]\n"; |
|
# If they've specified a file and this doesn't match, skip it. |
|
next if (($file) && ($this_file !~ /$file$/)); |
|
if (exists $an->data->{words}{$this_file}{language}{$language}{key}{$key}{content}) |
|
{ |
|
$string = $an->data->{words}{$this_file}{language}{$language}{key}{$key}{content}; |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n"; |
|
last; |
|
} |
|
} |
|
} |
|
|
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n"; |
|
return($string); |
|
} |
|
|
|
=head2 language |
|
|
|
This sets or returns the output language ISO code. |
|
|
|
Get the current log language; |
|
|
|
my $language = $an->Words->language; |
|
|
|
Set the output langauge to Japanese; |
|
|
|
$an->Words->language({set => "jp"}); |
|
|
|
=cut |
|
sub language |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $set = defined $parameter->{set} ? $parameter->{set} : ""; |
|
|
|
if ($set) |
|
{ |
|
$self->{WORDS}{LANGUAGE} = $set; |
|
} |
|
|
|
if (not $self->{WORDS}{LANGUAGE}) |
|
{ |
|
$self->{WORDS}{LANGUAGE} = $an->data->{defaults}{language}{output}; |
|
} |
|
|
|
return($self->{WORDS}{LANGUAGE}); |
|
} |
|
|
|
=head2 read |
|
|
|
This reads in a words file containing translated strings used to generated output for the user. |
|
|
|
Example to read 'C<< an-tools.xml >>'; |
|
|
|
my $words_file = $an->data->{path}{words}{'an-words.xml'}; |
|
my $an->Words->read({file => $words_file}) or die "Failed to read: [$words_file]. Does the file exist?\n"; |
|
|
|
Successful read will return '0'. Non-0 is an error; |
|
0 = OK |
|
1 = Invalid file name or path |
|
2 = File not found |
|
3 = File not readable |
|
4 = File found, failed to read for another reason. The error details will be printed. |
|
|
|
NOTE: Read works are stored in 'C<< $an->data->{words}{<file_name>}{language}{<language>}{string}{content} >>'. Metadata, like what languages are provided, are stored under 'C<< $an->data->{words}{<file_name>}{meta}{...} >>'. |
|
|
|
Parameters; |
|
|
|
=head3 file (required) |
|
|
|
This is the file to read. |
|
|
|
=cut |
|
sub read |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $file = defined $parameter->{file} ? $parameter->{file} : 0; |
|
my $return_code = 0; |
|
|
|
if (not $file) |
|
{ |
|
# NOTE: Log the problem, do not translate. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' called without a file name to read."}); |
|
$return_code = 1; |
|
} |
|
elsif (not -e $file) |
|
{ |
|
# NOTE: Log the problem, do not translate. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not found."}); |
|
$return_code = 2; |
|
} |
|
elsif (not -r $file) |
|
{ |
|
# NOTE: Log the problem, do not translate. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."])."}); |
|
$return_code = 3; |
|
} |
|
else |
|
{ |
|
# Read the file with XML::Simple |
|
my $xml = XML::Simple->new(); |
|
eval { $an->data->{words}{$file} = $xml->XMLin($file, KeyAttr => { language => 'name', key => 'name' }, ForceArray => [ 'language', 'key' ]) }; |
|
if ($@) |
|
{ |
|
chomp $@; |
|
my $error = "[ Error ] - The was a problem reading: [$file]. The error was:\n"; |
|
$error .= "===========================================================\n"; |
|
$error .= $@."\n"; |
|
$error .= "===========================================================\n"; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => $error}); |
|
$return_code = 4; |
|
} |
|
else |
|
{ |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0028", variables => { file => $file }}); |
|
} |
|
} |
|
|
|
return($return_code); |
|
} |
|
|
|
=head2 string |
|
|
|
This method takes a string key and returns the string in the requested language. If not key is passed, the language key in 'defaults::languages::output' is used. A hash reference containing variables can be provided to inject values into a string. |
|
|
|
If the requested string is not found, 'C<< #!not_found!# >>' is returned. |
|
|
|
Example to retrieve 'C<< t_0001 >>'; |
|
|
|
my $string = $an->Words->string({key => 't_0001'}); |
|
|
|
This time, requesting 'C<< t_0002 >>' and passing in two variables. Note that 'C<< t_0002 >>' in Canadian English is; |
|
|
|
Test Out of order: [#!variable!second!#] replace: [#!variable!first!#]. |
|
|
|
So to request this string in Canadian English is the two variables inserted, we would call: |
|
|
|
my $string = $an->Words->string({ |
|
language => 'en_CA', |
|
key => 't_0002', |
|
variables => { |
|
first => "foo", |
|
second => "bar", |
|
}, |
|
}); |
|
|
|
This would return; |
|
|
|
Test Out of order: [bar] replace: [foo]. |
|
|
|
Normally, there should never be a key collision. However, just in case you find yourself needing to request the string from a specific file, you can do the same call with a file specified. |
|
|
|
my $string = $an->Words->string({ |
|
language => 'en_CA', |
|
file => 'an-tools.xml', |
|
key => 't_0002', |
|
variables => { |
|
first => "foo", |
|
second => "bar", |
|
}, |
|
}); |
|
|
|
If the passed in key isn't found (at all, or for the given language or file if specified), then 'C<< #!not_found!# >>' will be returned. |
|
|
|
Parameters; |
|
|
|
=head3 file (optional) |
|
|
|
This is the specific file to read the string from. It should generally not be needed as string keys should not be reused. However, if it happens, this is a way to specify which file's version you want. |
|
|
|
=head3 key (required) |
|
|
|
This is the key to return the string for. |
|
|
|
NOTE: This is ignored when 'C<< string >>' is used. |
|
|
|
=head3 language (optional) |
|
|
|
This is the ISO code for the language you wish to read the string from. For example, 'en_CA' to get the Canadian English string, or 'jp' for the Japanese string. |
|
|
|
When no language is passed, 'C<< defaults::languages::output >>' is used. |
|
|
|
=head3 string (optional) |
|
|
|
If this is passed, it is treated as a raw string that needs variables inserted. When this is used, the 'C<< key >>' parameter is ignored. |
|
|
|
=head3 variables (depends) |
|
|
|
If the string being requested has one or more 'C<< #!variable!x!# >>' replacement keys, then you must pass a hash reference containing the keys / value pairs where the key matches the replacement string. |
|
|
|
=cut |
|
sub string |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $key = defined $parameter->{key} ? $parameter->{key} : ""; |
|
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Words->language; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
my $string = defined $parameter->{string} ? $parameter->{string} : ""; |
|
my $variables = defined $parameter->{variables} ? $parameter->{variables} : ""; |
|
|
|
# If we weren't passed a raw string, we'll get the string from our ->key() method, the inject any |
|
# variables, if needed. This also handles the initial sanity checks. If we get back '#!not_found!#', |
|
# we'll exit. |
|
if (not $string) |
|
{ |
|
$string = $an->Words->key({ |
|
key => $key, |
|
language => $language, |
|
file => $file, |
|
}); |
|
} |
|
|
|
if (($string ne "#!not_found!#") && ($string =~ /#!([^\s]+?)!#/)) |
|
{ |
|
# We've got a string and variables from the caller, so inject them as needed. |
|
my $loops = 0; |
|
my $limit = $an->data->{defaults}{limits}{string_loops} =~ /^\d+$/ ? $an->data->{defaults}{limits}{string_loops} : 1000; |
|
|
|
# We set the 'loop' variable to '1' and check it at the end of each pass. This is done |
|
# because we might inject a string near the end that adds a replacement key to an |
|
# otherwise-processed string and we don't want to miss that. |
|
my $loop = 1; |
|
while ($loop) |
|
{ |
|
# First, look for any '#!...!#' keys that we don't recognize and protect them. We'll |
|
# restore them once we're out of this loop. |
|
foreach my $check ($string =~ /#!([^\s]+?)!#/) |
|
{ |
|
if (($check !~ /^replace/) && |
|
($check !~ /^data/) && |
|
($check !~ /^string/) && |
|
($check !~ /^variable/)) |
|
{ |
|
# Simply invert the '#!...!#' to '!#...#!'. |
|
$string =~ s/#!($check)!#/!#$1#!/g; |
|
} |
|
|
|
# Die if I've looped too many times. |
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
} |
|
|
|
# Now, look for any '#!string!x!#' embedded strings. |
|
while ($string =~ /#!string!(.+?)!#/) |
|
{ |
|
my $key = $1; |
|
my $this_string = $an->Words->key({ |
|
key => $key, |
|
language => $language, |
|
file => $file, |
|
}); |
|
if ($this_string eq "#!not_found!#") |
|
{ |
|
# The key was bad... |
|
$string =~ s/#!string!$key!#/!!e[$key]!!/; |
|
} |
|
else |
|
{ |
|
$string =~ s/#!string!$key!#/$this_string/; |
|
} |
|
|
|
# Die if I've looped too many times. |
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
} |
|
|
|
# Now insert variables in the strings. |
|
while ($string =~ /#!variable!(.+?)!#/s) |
|
{ |
|
my $variable = $1; |
|
|
|
# Sometimes, #!variable!*!# is used in explaining things to users. So we need |
|
# to escape it. It will be restored later in '_restore_protected()'. |
|
if ($variable eq "*") |
|
{ |
|
$string =~ s/#!variable!\*!#/!#variable!*#!/; |
|
next; |
|
} |
|
|
|
if (not defined $variables->{$variable}) |
|
{ |
|
# I can't expect there to always be a defined value in the variables |
|
# array at any given position so if it is blank qw blank the key. |
|
$string =~ s/#!variable!$variable!#//; |
|
} |
|
else |
|
{ |
|
my $value = $variables->{$variable}; |
|
chomp $value; |
|
$string =~ s/#!variable!$variable!#/$value/; |
|
} |
|
|
|
# Die if I've looped too many times. |
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
} |
|
|
|
# Next, convert '#!data!x!#' to the value in '$an->data->{x}'. |
|
while ($string =~ /#!data!(.+?)!#/) |
|
{ |
|
my $id = $1; |
|
if ($id =~ /::/) |
|
{ |
|
# Multi-dimensional hash. |
|
my $value = $an->_get_hash_reference({ key => $id }); |
|
if (not defined $value) |
|
{ |
|
$string =~ s/#!data!$id!#/!!a[$id]!!/; |
|
} |
|
else |
|
{ |
|
$string =~ s/#!data!$id!#/$value/; |
|
} |
|
} |
|
else |
|
{ |
|
# One dimension |
|
if (not defined $an->data->{$id}) |
|
{ |
|
$string =~ s/#!data!$id!#/!!b[$id]!!/; |
|
} |
|
else |
|
{ |
|
my $value = $an->data->{$id}; |
|
$string =~ s/#!data!$id!#/$value/; |
|
} |
|
} |
|
|
|
# Die if I've looped too many times. |
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
} |
|
|
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
|
|
# If there are no replacement keys left, exit the loop. |
|
if ($string !~ /#!([^\s]+?)!#/) |
|
{ |
|
$loop = 0; |
|
} |
|
} |
|
|
|
# Restore any protected keys. Reset the loop counter, too. |
|
$loops = 0; |
|
$loop = 1; |
|
while ($loop) |
|
{ |
|
$string =~ s/!#([^\s]+?)#!/#!$1!#/g; |
|
|
|
$loops++; |
|
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; |
|
|
|
if ($string !~ /!#[^\s]+?#!/) |
|
{ |
|
$loop = 0; |
|
} |
|
} |
|
} |
|
|
|
# In some multi-line strings, the last line will be '\t\t</key>'. We clean this up. |
|
$string =~ s/\t\t$//; |
|
|
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n"; |
|
return($string); |
|
} |
|
|
|
# =head3 |
|
# |
|
# Private Functions; |
|
# |
|
# =cut |
|
|
|
############################################################################################################# |
|
# Private functions # |
|
############################################################################################################# |
|
|
|
1;
|
|
|