* Added the new Words->string() method to insert variables, data and other strings into the requested 'key'. This is a condensed and cleaned up version of v2's String->get() method.

* Added the new $an->_get_hash_reference() method that takes a key in the format "foo::bar" and returns the contents of $an->data->{foo}{bar}.
* Added the new Words->clean_spaces() method that removes leading and trailing spaces from a string, and condenses multiple spaces into single ones to simplify string parsing.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 8 years ago
parent dab7b17517
commit a844136c3b
  1. 62
      AN/Tools.pm
  2. 282
      AN/Tools/Words.pm

@ -135,8 +135,8 @@ sub new
$an->data($parameter->{data}) if $parameter->{data}; $an->data($parameter->{data}) if $parameter->{data};
# Set my search directory to @INC + $ENV{'PATH'}, minus directories that don't exist. We trigger this # Set my search directory to @INC + $ENV{'PATH'}, minus directories that don't exist. We trigger this
# build by passing in an invalid directory list. # build by passing in an empty directory list.
$an->Storage->search_directories({ directories => 1 }); $an->Storage->search_directories({ directories => "" });
# I need to read the initial words early. # I need to read the initial words early.
$an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}); $an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}});
@ -323,6 +323,57 @@ sub _add_hash_reference
} }
} }
=head2 _get_hash_reference
This is called when we need to parse a double-colon separated string into two or more elements which represent keys in the 'C<< $an->data >>' hash. Once suitably split up, the value is read and returned.
For example;
$an->data->{foo}{bar} = "baz";
my $value = $an->_get_hash_reference({ key => "foo::bar" });
The 'C<< $value >>' now contains "C<< baz >>".
NOTE: If the key is not found, 'C<< undef >>' is returned.
Parameters;
=head3 key (required)
This is the key to return the value for. If it is not passed, or if it does not have 'C<< :: >>' in it, 'C<< undef >>' will be returned.
=cut
sub _get_hash_reference
{
# 'href' is the hash reference I am working on.
my $self = shift;
my $parameter = shift;
my $an = $self;
#print "$THIS_FILE ".__LINE__."; hash: [".$an."], key: [$parameter->{key}]\n";
die "$THIS_FILE ".__LINE__."; The hash key string: [$parameter->{key}] doesn't seem to be valid. It should be a string in the format 'foo::bar::baz'.\n" if $parameter->{key} !~ /::/;
# Split up the keys.
my $key = $parameter->{key} ? $parameter->{key} : "";
my $value = undef; # We return 'undef' so that the caller can tell the difference between an empty string versus nothing found.
if ($key =~ /::/)
{
my @keys = split /::/, $key;
my $last_key = pop @keys;
# Re-order the array.
my $current_hash_ref = $an->data;
foreach my $key (@keys)
{
$current_hash_ref = $current_hash_ref->{$key};
}
$value = $current_hash_ref->{$last_key};
}
return ($value);
}
=head2 _make_hash_reference =head2 _make_hash_reference
This takes a string with double-colon seperators and divides on those double-colons to create a hash reference where each element is a hash key. This takes a string with double-colon seperators and divides on those double-colons to create a hash reference where each element is a hash key.
@ -361,9 +412,16 @@ sub _set_defaults
$an->data->{defaults} = { $an->data->{defaults} = {
languages => { languages => {
# Default log langauge.
'log' => 'en_CA', 'log' => 'en_CA',
# Default language for all output shown to a user.
output => 'en_CA', output => 'en_CA',
}, },
limits => {
# This is the maximum number of times we're allow to loop when injecting variables
# into a string being processed in AN::Tools::Words->string();
string_loops => 1000,
}
}; };
return(0); return(0);

@ -16,8 +16,10 @@ my $THIS_FILE = "Words.pm";
# $ENV{'PERL_UNICODE'} = 1; # $ENV{'PERL_UNICODE'} = 1;
### Methods; ### Methods;
# clean_spaces
# key # key
# read # read
# string
=pod =pod
@ -73,6 +75,34 @@ sub parent
# Public methods # # 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 =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. 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.
@ -90,7 +120,7 @@ Same, but specifying the key from Canadian english;
my $string = $an->Words->key({ my $string = $an->Words->key({
key => 't_0001', key => 't_0001',
language => 'en_CA', language => 'en_CA',
}) });
Same, but specifying a source file. Same, but specifying a source file.
@ -98,10 +128,16 @@ Same, but specifying a source file.
key => 't_0001', key => 't_0001',
language => 'en_CA', language => 'en_CA',
file => 'an-tools.xml', file => 'an-tools.xml',
}) });
Parameters; 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) =head3 key (required)
This is the key to return the string for. This is the key to return the string for.
@ -112,12 +148,6 @@ This is the ISO code for the language you wish to read. For example, 'en_CA' to
When no language is passed, 'C<< $an->data->{defaults}{languages}{output} >>' is used. When no language is passed, 'C<< $an->data->{defaults}{languages}{output} >>' is used.
=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 >>'.
=cut =cut
sub key sub key
{ {
@ -253,6 +283,242 @@ sub read
return($return_code); 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.
=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 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->data->{defaults}{languages}{output};
my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
# 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.
my $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;
}
}
}
#print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n";
return($string);
}
# =head3 # =head3
# #
# Private Functions; # Private Functions;

Loading…
Cancel
Save