* Fixed the double-encoding messages when using XML::Simple to read in words files. Our use for XML is simple, so despite XML::Simple being discouraged, it suits our needs well.

* Created tests for most existing module methods now.
* Updated Storage->search_directories to handle merging @INC and $ENV{'PATH'} when called with an invalid directories parameter, and exploited this behaviour to initially set the directory search list. This also deprecated the Tools->_add_environment_path_to_search_directories() method.
* Added Storage->read_config based on the old v2 'Storage->read_conf()'. Also ported over the old Tools->_add_hash_reference() and Tools->_make_hash_reference() methods to assist with this method's operation.
* Created Words->key() that returns the raw string for a given language and key.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 8 years ago
parent ec307bc019
commit dab7b17517
  1. 145
      AN/Tools.pm
  2. 67
      AN/Tools.t
  3. 201
      AN/Tools/Storage.pm
  4. 172
      AN/Tools/Words.pm
  5. 5
      AN/an-tools.xml

@ -5,10 +5,10 @@ package AN::Tools;
BEGIN BEGIN
{ {
our $VERSION = "3.0.000"; our $VERSION = "3.0.0";
# This suppresses the 'could not find ParserDetails.ini in /PerlApp/XML/SAX' warning message in # This suppresses the 'could not find ParserDetails.ini in /PerlApp/XML/SAX' warning message in
# XML::Simple calls. # XML::Simple calls.
$ENV{HARNESS_ACTIVE} = 1; #$ENV{HARNESS_ACTIVE} = 1;
} }
use strict; use strict;
@ -16,9 +16,17 @@ use warnings;
use Data::Dumper; use Data::Dumper;
my $THIS_FILE = "Tools.pm"; my $THIS_FILE = "Tools.pm";
# Setup for UTF-8 mode. ### Methods;
# data
# environment
# _add_hash_reference
# _make_hash_reference
# _set_defaults
# _set_paths
use utf8; use utf8;
$ENV{'PERL_UNICODE'} = 1; binmode(STDERR, ':encoding(utf-8)');
binmode(STDOUT, ':encoding(utf-8)');
# I intentionally don't use EXPORT, @ISA and the like because I want my "subclass"es to be accessed in a # I intentionally don't use EXPORT, @ISA and the like because I want my "subclass"es to be accessed in a
# somewhat more OO style. I know some may wish to strike me down for this, but I like the idea of accessing # somewhat more OO style. I know some may wish to strike me down for this, but I like the idea of accessing
@ -117,9 +125,8 @@ sub new
$an->Words->parent($an); $an->Words->parent($an);
# Set some system paths and system default variables # Set some system paths and system default variables
$an->_add_environment_path_to_search_directories;
$an->_set_paths; $an->_set_paths;
# $an->_set_defaults; $an->_set_defaults;
# This checks the environment this program is running in. # This checks the environment this program is running in.
$an->environment; $an->environment;
@ -127,39 +134,18 @@ sub new
# Setup my '$an->data' hash right away so that I have a place to store the strings hash. # Setup my '$an->data' hash right away so that I have a place to store the strings hash.
$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
# build by passing in an invalid directory list.
$an->Storage->search_directories({ directories => 1 });
# 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'}});
# Set passed parameters if needed. # Set passed parameters if needed.
if (ref($parameter) eq "HASH") if (ref($parameter) eq "HASH")
{ {
### Local parameters ### TODO: Calls to allow the user to override defaults...
# Reset the paths # Local parameters...
# $an->_set_paths;
#
# ### AN::Tools::Log parameters
# # Set the default languages.
# $an->default_language ($parameter->{'Log'}{user_language}) if $parameter->{'Log'}{user_language};
# $an->default_log_language ($parameter->{'Log'}{log_language}) if $parameter->{'Log'}{log_language};
#
# # Set the log file.
# $an->Log->level ($parameter->{'Log'}{level}) if defined $parameter->{'Log'}{level};
# $an->Log->db_transactions ($parameter->{'Log'}{db_transactions}) if defined $parameter->{'Log'}{db_transactions};
#
# ### AN::Tools::Readable parameters
# # Readable needs to be set before Log so that changes to 'base2' are made before the default
# # log cycle size is interpreted.
# $an->Readable->base2 ($parameter->{Readable}{base2}) if defined $parameter->{Readable}{base2};
#
# ### AN::Tools::String parameters
# # Force UTF-8.
# $an->String->force_utf8 ($parameter->{String}{force_utf8}) if defined $parameter->{String}{force_utf8};
#
# # Read in the user's words.
# $an->Storage->read_words({file => $parameter->{String}{file}}) if defined $parameter->{String}{file};
#
# ### AN::Tools::Get parameters
# $an->Get->use_24h ($parameter->{'Get'}{use_24h}) if defined $parameter->{'Get'}{use_24h};
} }
elsif($parameter) elsif($parameter)
{ {
@ -168,27 +154,6 @@ sub new
exit(1); exit(1);
} }
# Call methods that need to be loaded at invocation of the module.
# if (($an->{DEFAULT}{STRINGS} =~ /^\.\//) && (not -e $an->{DEFAULT}{STRINGS}))
# {
# # Try to find the location of this module (I can't use Dir::Self' because it is not provided
# # by RHEL 6)
# my $root = ($INC{'AN/Tools.pm'} =~ /^(.*?)\/AN\/Tools.pm/)[0];
# my $file = ($an->{DEFAULT}{STRINGS} =~ /^\.\/(.*)/)[0];
# my $path = "$root/$file";
# if (-e $path)
# {
# # Found the words file.
# $an->{DEFAULT}{STRINGS} = $path;
# }
# }
# if (not -e $an->{DEFAULT}{STRINGS})
# {
# print "Failed to read the core words file: [".$an->{DEFAULT}{STRINGS}."]\n";
# $an->nice_exit({exit_code => 255});
# }
# $an->Storage->read_words({file => $an->{DEFAULT}{STRINGS}});
return ($self); return ($self);
} }
@ -332,35 +297,74 @@ These methods generally should never be called from a program using AN::Tools. H
# Private methods # # Private methods #
############################################################################################################# #############################################################################################################
=head2 _add_environment_path_to_search_directories =head2 _add_hash_reference
This is a helper to the '$an->_make_hash_reference' method. It is called each time a new string is to be created as a new hash key in the passed hash reference.
This method merges @INC and $ENV{'PATH'} into a single array and uses the result to set C<< $an->Storage->search_directories >>. NOTE: Contributed by Shaun Fryer and Viktor Pavlenko by way of Toronto Perl Mongers.
=cut =cut
sub _add_environment_path_to_search_directories sub _add_hash_reference
{ {
my ($an) = shift; my $self = shift;
my $href1 = shift;
my $href2 = shift;
# If I have $ENV{'PATH'}, use it to add to $an->Storage->search_directories(). for my $key (keys %$href2)
if (($ENV{'PATH'}) && ($ENV{'PATH'} =~ /:/))
{ {
my $new_hash = []; if (ref $href1->{$key} eq 'HASH')
my $last_directory = "";
foreach my $directory (sort {$a cmp $b} @INC, (split/:/, $ENV{'PATH'}))
{ {
if (($directory eq ".") && ($ENV{PWD})) $self->_add_hash_reference( $href1->{$key}, $href2->{$key} );
}
else
{ {
$directory = $ENV{PWD}; $href1->{$key} = $href2->{$key};
} }
next if $directory eq $last_directory;
push @{$new_hash}, $directory;
} }
}
=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.
if (@{$new_hash} > 1) NOTE: Contributed by Shaun Fryer and Viktor Pavlenko by way of Toronto Perl Mongers.
=cut
sub _make_hash_reference
{
my $self = shift;
my $href = shift;
my $key_string = shift;
my $value = shift;
my @keys = split /::/, $key_string;
my $last_key = pop @keys;
my $_href = {};
$_href->{$last_key} = $value;
while (my $key = pop @keys)
{ {
$an->Storage->search_directories({directories => $new_hash}); my $elem = {};
} $elem->{$key} = $_href;
$_href = $elem;
} }
$self->_add_hash_reference($href, $_href);
}
=head2 _set_defaults
This sets default variable values for the program.
=cut
sub _set_defaults
{
my ($an) = shift;
$an->data->{defaults} = {
languages => {
'log' => 'en_CA',
output => 'en_CA',
},
};
return(0); return(0);
} }
@ -439,6 +443,7 @@ The following packages are required on EL7.
* C<policycoreutils-python> * C<policycoreutils-python>
* C<postgresql> * C<postgresql>
* C<syslinux> * C<syslinux>
* C<perl-XML-Simple>
=head1 Recommended Packages =head1 Recommended Packages

@ -3,20 +3,81 @@
use strict; use strict;
use warnings; use warnings;
use POSIX; use POSIX;
use Data::Dumper;
use utf8;
# Be nice and set a version number. # Be nice and set a version number.
our $VERSION="3.0.0"; our $VERSION="3.0.0";
# Call in the test module, telling it how many tests to expect to run. # Call in the test module, telling it how many tests to expect to run.
use Test::More tests => 2; use Test::More tests => 28;
# Load my module via 'use_ok' test. # Load my module via 'use_ok' test.
BEGIN BEGIN
{ {
print "Will now test AN::Tools on $^O.\n"; print "Beginning tests of the AN::Tools suite of modules.\n";
use_ok('AN::Tools', 3.0.0); use_ok('AN::Tools', 3.0.0);
} }
### Core tests
my $an = AN::Tools->new(); my $an = AN::Tools->new();
like($an, qr/^AN::Tools=HASH\(0x\w+\)$/, "AN::Tools object appears valid."); like($an, qr/^AN::Tools=HASH\(0x\w+\)$/, "Verifying that AN::Tools object is valid.");
like($an->data, qr/^HASH\(0x\w+\)$/, "Verifying that '\$an->data' is a hash reference.");
is($an->environment, "cli", "Verifying that \$an->environment initially reports 'cli'.");
$an->environment('html');
is($an->environment, "html", "Verifying that \$an->environment was properly set to 'html'.");
$an->environment('cli');
is($an->environment, "cli", "Verifying that \$an->environment was properly reset back to 'cli'.");
# Test handles to child modules.
like($an->Alert, qr/^AN::Tools::Alert=HASH\(0x\w+\)$/, "Verifying that '\$an->Alert' is a handle to AN::Tools::Alert.");
like($an->Storage, qr/^AN::Tools::Storage=HASH\(0x\w+\)$/, "Verifying that '\$an->Alert' is a handle to AN::Tools::Storage.");
like($an->Words, qr/^AN::Tools::Words=HASH\(0x\w+\)$/, "Verifying that '\$an->Alert' is a handle to AN::Tools::Words.");
### AN::Tools::Storage methods
# Search directory tests
my $array1 = $an->Storage->search_directories;
my $a1_count = @{$array1};
cmp_ok($a1_count, '>', 0, "Verifying that \$an->Storage->search_directories has at least one entry. Found: [$a1_count] directories.");
$an->Storage->search_directories({directories => "/root,/usr/bin,/some/fake/directory"});
my $array2 = $an->Storage->search_directories;
my $a2_count = @{$array2};
cmp_ok($a2_count, '==', 2, "Verifying that \$an->Storage->search_directories now has 2 entries from a passed in CSV, testing that the list changed and a fake directory was dropped.");
$an->Storage->search_directories({directories => ["/usr/bin", "/tmp", "/home"] });
my $array3 = $an->Storage->search_directories;
my $a3_count = @{$array3};
cmp_ok($a3_count, '==', 3, "Verifying that \$an->Storage->search_directories now has 3 entries from a passed in array reference, verifying that the list changed again.");
$an->Storage->search_directories({directories => "invalid" });
my $array4 = $an->Storage->search_directories;
my $a4_count = @{$array4};
cmp_ok($a4_count, '==', $a1_count, "Verifying that \$an->Storage->search_directories has the original number of directories: [$a4_count] after being called with an invalid 'directories' parameter, showing that it reset properly.");
my $test_path = $an->Storage->find({ file => "AN/Tools.t" });
is($test_path, "/usr/share/perl5/AN/Tools.t", "Verifying that \$an->Storage->find successfully found 'AN/Tools.t'.");
my $bad_path = $an->Storage->find({ file => "AN/wa.t" });
is($bad_path, "#!not_found!#", "Verifying that \$an->Storage->find properly returned '#!not_found!#' for a non-existed file.");
# Config file read tests.
$an->data->{foo}{bar}{a} = "test";
is($an->Storage->read_config({ file => "AN/test.conf" }), 0, "Verifying that '\$an->Storage->read_config' successfully found 'AN/test.conf'.");
is($an->Storage->read_config({ file => "" }), 1, "Verifying that '\$an->Storage->read_config' returns '1' when called without a 'file' parameter being set.");
is($an->Storage->read_config({ file => "AN/moo.conf" }), 2, "Verifying that '\$an->Storage->read_config' returns '2' when the non-existent 'AN/moo.conf' is passed.");
cmp_ok($an->data->{foo}{bar}{a}, 'eq', 'I am "a"', "Verifying that 'AN/test.conf's 'foo::bar::a' overwrote an earlier set value.");
cmp_ok($an->data->{foo}{bar}{b}, 'eq', 'I am "b", split with tabs and having trailing spaces.', "Verifying that 'AN/test.conf's 'foo::bar::b' has whitespaces removed as expected.");
cmp_ok($an->data->{foo}{baz}{1}, 'eq', 'This is \'1\' with no spaces', "Verifying that 'AN/test.conf's 'foo::baz::1' parsed without spaces around '='.");
cmp_ok($an->data->{foo}{baz}{2}, 'eq', 'I had a $dollar = sign and split with tabs.', "Verifying that 'AN/test.conf's 'foo::baz::2' had no trouble with a '$' and '=' characters in the string.");
### AN::Tools::Words methods
# Make sure we can read words files
is($an->Words->read({file =>$an->data->{path}{words}{'an-tools.xml'}}), 0, "Verifying that '\$an->Words->read' properly returned '0' when asked to read the AN::Tools's words file.");
is($an->Words->read({file => ''}), 1, "Verifying that '\$an->Words->read' properly returned '1' when asked to read a works file without a file being passed.");
is($an->Words->read({file => '/tmp/dummy.xml'}), 2, "Verifying that '\$an->Words->read' properly returned '2' when asked to read a non-existent file.");
### NOTE: At this time, we don't test for unreadable files (rc = 3) or general read faults as set by XML::Simple (rc = 4).
# Make sure we can read strings.
is($an->Words->key({key => 't_0001'}), "Test replace: [#!variable!test!#].", "Verifying that '\$an->Words->key' returned the Canadian English 't_0001' string.");
is($an->Words->key({key => 't_0001', language => 'jp'}), "テスト いれかえる: [#!variable!test!#]。", "Verifying that '\$an->Words->read' returned the Japanese 't_0001' string.");
is($an->Words->key({key => 't_0003', language => 'jp'}), "#!not_found!#", "Verifying that '\$an->Words->read' returned '#!not_found!#' for the missing 't_0003' key.");

@ -12,6 +12,7 @@ my $THIS_FILE = "Storage.pm";
### Methods; ### Methods;
# find # find
# read_config
# search_directories # search_directories
=pod =pod
@ -73,9 +74,9 @@ sub parent
=head2 find =head2 find
This searches for the given file on the system. It will search in the directories returned by C<$an->Storage->search_directories()>. This searches for the given file on the system. It will search in the directories returned by C<< $an->Storage->search_directories() >>.
Example to search for 'C<foo>'; Example to search for 'C<< foo >>';
$an->Storage->find({file => "foo"}); $an->Storage->find({file => "foo"});
@ -86,15 +87,15 @@ Same, but error out if the file isn't found.
fatal => 1, fatal => 1,
}); });
If it fails to find the file and C<fatal> isn't set to C<1>, 'C<0>' is returned. If it fails to find the file and C<< fatal >> isn't set to 'C<< 1 >>', 'C<< 0 >>' is returned.
Parameters; Parameters;
=head3 fatal C<0|1> =head3 fatal (optional)
This can be set to '1' to tell the method to throw an error and exit if the file is not found. Default is '0' which only triggers a warning of the file isn't found. This can be set to 'C<< 1 >>' to tell the method to throw an error and exit if the file is not found. Default is 'C<< 0 >>' which only triggers a warning of the file isn't found.
=head3 file =head3 file (required)
This is the name of the file to search for. This is the name of the file to search for.
@ -110,7 +111,7 @@ sub find
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
# Each full path and file name will be stored here before the test. # Each full path and file name will be stored here before the test.
my $full_path = ""; my $full_path = "#!not_found!#";
foreach my $directory (@{$an->Storage->search_directories()}) foreach my $directory (@{$an->Storage->search_directories()})
{ {
# If "directory" is ".", expand it. # If "directory" is ".", expand it.
@ -120,19 +121,28 @@ sub find
} }
# Put together the initial path # Put together the initial path
$full_path = $directory."/".$file; my $test_path = $directory."/".$file;
# Clear double-delimiters. # Clear double-delimiters.
$full_path =~ s/\/+/\//g; $test_path =~ s/\/+/\//g;
if (-f $full_path) #print $THIS_FILE." ".__LINE__."; [ Debug ] - Test path: [$test_path] - ";
if (-f $test_path)
{ {
# Found it, return. # Found it!
return ($full_path); #print "Found!\n";
$full_path = $test_path;
last;
}
else
{
#print "Not found...\n";
} }
} }
# Die if we didn't find the file and fatal is set. # Die if we didn't find the file and fatal is set.
if ($full_path !~ /^\//)
{
if ($fatal) if ($fatal)
{ {
### TODO: Make this $an->Alert->error() later ### TODO: Make this $an->Alert->error() later
@ -148,9 +158,132 @@ sub find
print "Exiting on errors.\n"; print "Exiting on errors.\n";
exit(2); exit(2);
} }
}
# Return
return ($full_path);
}
=head2 read_config
This method is used to read 'AN::Tools' style configuration files. These configuration files are in the format:
# This is a comment for the 'a::b::c' variable
a::b::c = x
A configuration file can be read in like this;
$an->Storage->read_config({ file => "test.conf" });
In this example, the file 'C<< test.conf >>' will be searched for in the directories returned by 'C<< $an->Storage->search_directories >>'.
Any line starting with '#' is a comment and is ignored. Preceding white spaces are allowed and also ignored.
Any line in the format 'x = y' is treated as a variable / value pair, split on the first 'C<< = >>'. Whitespaces on either side of the 'C<< = >>' are removed and ignored. However, anything after the first non-whitespace character is treated as data an unmolested. This includes addition 'C<< = >>' characters, white spaces and so on. The exception is that trailing white spaces are cropped and ignored. If nothing comes after the 'C<< = >>', the variable is set to a blank string.
Successful read will return 'C<< 0 >>'. Non-0 is an error;
C<< 0 >> = OK
C<< 1 >> = Invalid or missing file name
C<< 2 >> = File not found
C<< 3 >> = File not readable
Parameters;
=head3 file (required)
This is the configuration file to read.
If the 'C<< file >>' parameter starts with 'C<< / >>', the exact path to the file is used. Otherwise, this method will search for the file in the list of directories returned by 'C<< $an->Storage->search_directories >>'. The first match is read in.
All variables are stored in the root of 'C<< $an->data >>', allowing for configuration files to override internally set variables.
For example, if you set:
$an->data->{a}{b}{c} = "1";
Then you read in a config file with:
a::b::c = x
Then 'C<< $an->data->{a}{b}{c} >>' will now contain 'C<< x >>'.
=cut
sub read_config
{
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;
#print $THIS_FILE." ".__LINE__."; [ Debug ] - file: [$file].\n";
if (not $file)
{
# TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' called without a file name to read.\n";
$return_code = 1;
}
# If I have a file name that isn't a full path, find it.
if (($file) && ($file !~ /^\//))
{
# Find the file, if possible. If not found, we'll not alter what the user passed in and hope
# it is relative to where we are.
my $path = $an->Storage->find({ file => $file });
#print $THIS_FILE." ".__LINE__."; [ Debug ] - path: [$path].\n";
if ($path ne "#!not_found!#")
{
# Update the file
$file = $path;
#print $THIS_FILE." ".__LINE__."; [ Debug ] - file: [$file].\n";
}
}
if ($file)
{
if (not -e $file)
{
# TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not found.\n";
$return_code = 2;
}
elsif (not -r $file)
{
# TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."]).\n";
$return_code = 3;
}
else
{
# Read it in!
my $count = 0;
open (my $file_handle, "<$file") or die "Can't read: [$file], error was: $!\n";
while (<$file_handle>)
{
chomp;
my $line = $_;
$line =~ s/^\s+//;
$line =~ s/\s+$//;
$count++;
next if ((not $line) or ($line =~ /^#/));
next if $line !~ /=/;
my ($variable, $value) = split/=/, $line, 2;
$variable =~ s/\s+$//;
$value =~ s/^\s+//;
if (not $variable)
{
print $THIS_FILE." ".__LINE__."; [ Warning ] - The config file: [$file] appears to have a malformed line: [$count:$line].\n";
}
# If I am here, I failed but fatal errors are disabled. $an->_make_hash_reference($an->data, $variable, $value);
return (0); }
close $file_handle;
}
}
return($return_code);
} }
=head2 search_directories =head2 search_directories
@ -159,9 +292,11 @@ This method returns an array reference of directories to search within for files
Parameters; Parameters;
=head3 directories =head3 directories (optional)
This accepts either an array reference of directories to search, or a comma-separated string of directories to search (which will be converted to an array). When passed, this sets the internal list of directories to search.
This is either an array reference of directories to search, or a comma-separated string of directories to search. When passed, this sets the internal list of directories to search. By default, it is set to C<\@INC>. By default, it is set to all directories in C<< \@INC >> and the C<< $ENV{'PATH'} >> variables, minus directories that don't actually exist. The returned array is sorted alphabetically.
=cut =cut
sub search_directories sub search_directories
@ -183,13 +318,43 @@ sub search_directories
elsif (($array) && (ref($array) ne "ARRAY")) elsif (($array) && (ref($array) ne "ARRAY"))
{ {
# TODO: Make this a $an->Alert->warning(). # TODO: Make this a $an->Alert->warning().
print $THIS_FILE." ".__LINE__."; The passed in array: [$array] wasn't an array. Using \@INC for the list of directories to search instead.\n"; print $THIS_FILE." ".__LINE__."; [ Warning ] - The passed in array: [$array] wasn't actually an array. Using \@INC + \$ENV{'PATH'} for the list of directories to search instead.\n";
$array = \@INC;
# Create a new array containing the '$ENV{'PATH'}' directories and the @INC directories.
my @new_array = split/:/, $ENV{'PATH'} if $ENV{'PATH'} =~ /:/;
foreach my $directory (@INC)
{
push @new_array, $directory;
}
$array = \@new_array;
} }
# Store the new array, if set. # Store the new array, if set.
if (ref($array) eq "ARRAY") if (ref($array) eq "ARRAY")
{ {
# Dedupe and sort.
my $sorted_array = [];
my $seen_directories = {};
foreach my $directory (sort {$a cmp $b} @{$array})
{
# Convert '.' to $ENV{PWD}
if ($directory eq ".")
{
$directory = $ENV{PWD};
}
# Skip duplicates
next if exists $seen_directories->{$directory};
# Skip non-existent directories
next if not -d $directory;
# Record this directory.
$seen_directories->{$directory} = 1;
push @{$sorted_array}, $directory;
}
$array = $sorted_array;
$self->{SEARCH_DIRECTORIES} = $array; $self->{SEARCH_DIRECTORIES} = $array;
} }

@ -6,8 +6,7 @@ package AN::Tools::Words;
use strict; use strict;
use warnings; use warnings;
use Data::Dumper; use Data::Dumper;
use XML::LibXML; use XML::Simple qw(:strict);
use Encode;
our $VERSION = "3.0.0"; our $VERSION = "3.0.0";
my $THIS_FILE = "Words.pm"; my $THIS_FILE = "Words.pm";
@ -17,6 +16,7 @@ my $THIS_FILE = "Words.pm";
# $ENV{'PERL_UNICODE'} = 1; # $ENV{'PERL_UNICODE'} = 1;
### Methods; ### Methods;
# key
# read # read
=pod =pod
@ -73,12 +73,102 @@ sub parent
# Public methods # # Public methods #
############################################################################################################# #############################################################################################################
=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 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<< $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
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->data->{defaults}{languages}{output};
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 read =head2 read
This reads in a words file containing translated strings used to generated output for the user. This reads in a words file containing translated strings used to generated output for the user.
Example to read 'C<an-tools.xml>'; Example to read 'C<< an-tools.xml >>';
my $words_file = $an->data->{path}{words}{'an-words.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"; my $an->Words->read({file => $words_file}) or die "Failed to read: [$words_file]. Does the file exist?\n";
@ -88,13 +178,13 @@ Successful read will return '0'. Non-0 is an error;
1 = Invalid file name or path 1 = Invalid file name or path
2 = File not found 2 = File not found
3 = File not readable 3 = File not readable
4 = File found, but did not contain strings. 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} >>'. Metadata, like what languages are provided, are stored under 'C<< $an->data->{words}{<file_name>}{meta}{...} >>'. 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; Parameters;
=head3 file =head3 file (required)
This is the file to read. This is the file to read.
@ -112,62 +202,52 @@ sub read
if (not $file) if (not $file)
{ {
# TODO: Log the problem, do not translate. # TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; AN::Tools::Words->read()' called without a file name to read.\n"; print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' called without a file name to read.\n";
$return_code = 1; $return_code = 1;
} }
elsif (not -e $file) elsif (not -e $file)
{ {
# TODO: Log the problem, do not translate. # TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; AN::Tools::Words->read()' asked to read: [$file] which was not found.\n"; print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not found.\n";
$return_code = 2; $return_code = 2;
} }
elsif (not -r $file) elsif (not -r $file)
{ {
# TODO: Log the problem, do not translate. # TODO: Log the problem, do not translate.
print $THIS_FILE." ".__LINE__."; AN::Tools::Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."]).\n"; print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."]).\n";
$return_code = 3; $return_code = 3;
} }
else else
{ {
# Read the file with XML::LibXML # Read the file with XML::Simple
my $parser = XML::LibXML->new(); my $xml = XML::Simple->new();
my $dom = XML::LibXML->load_xml({location => $file}); eval { $an->data->{words}{$file} = $xml->XMLin($file, KeyAttr => { language => 'name', key => 'name' }, ForceArray => [ 'language', 'key' ]) };
if ($@)
{
chomp $@;
print $THIS_FILE." ".__LINE__."; [ Error ] - The was a problem reading: [$file]. The error was:\n";
print "===========================================================\n"; print "===========================================================\n";
print Dumper $dom; print $@."\n";
print "===========================================================\n"; print "===========================================================\n";
$return_code = 4;
# my $data = ""; }
# eval { $data = $xml->XMLin($file, KeyAttr => {node => 'name'}, ForceArray => 1) }; else
# if ($@) {
# { # Successfully read.
# chomp $@;
# print $THIS_FILE." ".__LINE__."; [ Error ] - The was a problem reading: [$file]. The error was:\n"; ### Some debug stuff
# print "===========================================================\n"; # Read the meta data
# print $@."\n"; #my $version = $an->data->{words}{$file}{meta}{version};
# print "===========================================================\n"; #my $languages = $an->data->{words}{$file}{meta}{languages};
# $return_code = 4; #print $THIS_FILE." ".__LINE__."; [ Debug ] - Version: [$version], languages: [$languages]\n";
# }
# else #foreach my $this_language (sort {$a cmp $b} keys %{$an->data->{words}{$file}{language}})
# { #{
# print "===========================================================\n"; # my $long_name = $an->data->{words}{$file}{language}{$this_language}{long_name};
# #print Dumper $data; # print $THIS_FILE." ".__LINE__."; [ Debug ] - this_language: [$this_language], long_name: [$long_name]\n";
# print Dumper $data->{language}; # print $THIS_FILE." ".__LINE__."; [ Debug ] - "$this_language:t_0001: [".$an->data->{words}{$file}{language}{$this_language}{key}{t_0001}{content}."]\n";
# print "===========================================================\n"; #}
# }
# # Read the meta data
# my $meta_found = 0;
# my $version = $data->{meta}->[0]->{version}->[0];
# my $languages = $data->{meta}->[0]->{languages}->[0];
# #print $THIS_FILE." ".__LINE__."; [ Debug ] - Version: [$version], languages: [$languages]\n";
#
# my $this_language = "";
# foreach my $hash_ref (@{$data->{language}})
# {
# $this_language = $hash_ref->{name};
# my $long_name = $hash_ref->{long_name};
# print $THIS_FILE." ".__LINE__."; [ Debug ] - this_language: [$this_language], long_name: [$long_name]\n";
# }
# }
} }
return($return_code); return($return_code);

@ -9,10 +9,7 @@ This is the AN::Tools master 'words' file.
--> -->
<words> <words>
<meta> <meta version="3.0.0" languages="en_CA,jp"/>
<version>3.0.0</version>
<languages>en_CA,jp</languages>
</meta>
<!-- Canadian English --> <!-- Canadian English -->
<language name="en_CA" long_name="Canadian English" description="Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules"> <language name="en_CA" long_name="Canadian English" description="Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules">

Loading…
Cancel
Save