Digimer
8 years ago
parent
4ac37e239f
commit
ec307bc019
4 changed files with 277 additions and 26 deletions
@ -0,0 +1,186 @@ |
|||||||
|
package AN::Tools::Words; |
||||||
|
# |
||||||
|
# This module contains methods used to handle storage related tasks |
||||||
|
# |
||||||
|
|
||||||
|
use strict; |
||||||
|
use warnings; |
||||||
|
use Data::Dumper; |
||||||
|
use XML::LibXML; |
||||||
|
use Encode; |
||||||
|
|
||||||
|
our $VERSION = "3.0.0"; |
||||||
|
my $THIS_FILE = "Words.pm"; |
||||||
|
|
||||||
|
# Setup for UTF-8 mode. |
||||||
|
# use utf8; |
||||||
|
# $ENV{'PERL_UNICODE'} = 1; |
||||||
|
|
||||||
|
### Methods; |
||||||
|
# read |
||||||
|
|
||||||
|
=pod |
||||||
|
|
||||||
|
=encoding utf8 |
||||||
|
|
||||||
|
=head1 NAME |
||||||
|
|
||||||
|
AN::Tools::Words |
||||||
|
|
||||||
|
Provides all methods related to generating translated strings for users. |
||||||
|
|
||||||
|
=head1 SYNOPSIS |
||||||
|
|
||||||
|
use AN::Tools::Words; |
||||||
|
|
||||||
|
# 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 = {}; |
||||||
|
|
||||||
|
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 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, but did not contain strings. |
||||||
|
|
||||||
|
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}{...} >>'. |
||||||
|
|
||||||
|
Parameters; |
||||||
|
|
||||||
|
=head3 file |
||||||
|
|
||||||
|
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) |
||||||
|
{ |
||||||
|
# TODO: Log the problem, do not translate. |
||||||
|
print $THIS_FILE." ".__LINE__."; AN::Tools::Words->read()' called without a file name to read.\n"; |
||||||
|
$return_code = 1; |
||||||
|
} |
||||||
|
elsif (not -e $file) |
||||||
|
{ |
||||||
|
# TODO: Log the problem, do not translate. |
||||||
|
print $THIS_FILE." ".__LINE__."; 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__."; AN::Tools::Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."]).\n"; |
||||||
|
$return_code = 3; |
||||||
|
} |
||||||
|
else |
||||||
|
{ |
||||||
|
# Read the file with XML::LibXML |
||||||
|
my $parser = XML::LibXML->new(); |
||||||
|
my $dom = XML::LibXML->load_xml({location => $file}); |
||||||
|
print "===========================================================\n"; |
||||||
|
print Dumper $dom; |
||||||
|
print "===========================================================\n"; |
||||||
|
|
||||||
|
# my $data = ""; |
||||||
|
# eval { $data = $xml->XMLin($file, KeyAttr => {node => 'name'}, ForceArray => 1) }; |
||||||
|
# if ($@) |
||||||
|
# { |
||||||
|
# chomp $@; |
||||||
|
# print $THIS_FILE." ".__LINE__."; [ Error ] - The was a problem reading: [$file]. The error was:\n"; |
||||||
|
# print "===========================================================\n"; |
||||||
|
# print $@."\n"; |
||||||
|
# print "===========================================================\n"; |
||||||
|
# $return_code = 4; |
||||||
|
# } |
||||||
|
# else |
||||||
|
# { |
||||||
|
# print "===========================================================\n"; |
||||||
|
# #print Dumper $data; |
||||||
|
# print Dumper $data->{language}; |
||||||
|
# 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); |
||||||
|
} |
||||||
|
|
||||||
|
# =head3 |
||||||
|
# |
||||||
|
# Private Functions; |
||||||
|
# |
||||||
|
# =cut |
||||||
|
|
||||||
|
############################################################################################################# |
||||||
|
# Private functions # |
||||||
|
############################################################################################################# |
||||||
|
|
||||||
|
1; |
||||||
@ -0,0 +1,37 @@ |
|||||||
|
<?xml version="1.0" encoding="UTF-8"?> |
||||||
|
|
||||||
|
<!-- |
||||||
|
Company: Alteeve's Niche, Inc. |
||||||
|
License: GPL v2+ |
||||||
|
Author: Madison Kelly <mkelly@alteeve.ca> |
||||||
|
|
||||||
|
This is the AN::Tools master 'words' file. |
||||||
|
--> |
||||||
|
|
||||||
|
<words> |
||||||
|
<meta> |
||||||
|
<version>3.0.0</version> |
||||||
|
<languages>en_CA,jp</languages> |
||||||
|
</meta> |
||||||
|
<!-- 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"> |
||||||
|
|
||||||
|
<!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. --> |
||||||
|
<key name="t_0000">Test</key> |
||||||
|
<key name="t_0001">Test replace: [#!variable!test!#].</key> |
||||||
|
<key name="t_0002">Test Out of order: [#!variable!second!#] replace: [#!variable!first!#].</key> |
||||||
|
<!-- Do not use 't_0003'. It is used to test failures caused by calling a non-existent key. --> |
||||||
|
<key name="t_0004">#!FREE!#</key> |
||||||
|
|
||||||
|
</language> |
||||||
|
<!-- 日本語 --> |
||||||
|
<language name="jp" long_name="日本語" description=">Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules."> |
||||||
|
|
||||||
|
<!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. --> |
||||||
|
<key name="t_0000">テスト</key> |
||||||
|
<key name="t_0001">テスト いれかえる: [#!variable!test!#]。</key> |
||||||
|
<key name="t_0002">テスト、 整理: [#!variable!second!#]/[#!variable!first!#]。</key> |
||||||
|
<!-- Do not use 't_0003'. It is used to test failures caused by calling a non-existent key. --> |
||||||
|
<key name="t_0004">#!FREE!#</key> |
||||||
|
</language> |
||||||
|
</words> |
||||||
Loading…
Reference in new issue