package AN::Tools; # # This is the "root" package that manages the sub modules and controls access to their methods. # BEGIN { our $VERSION = "3.0.0"; # This suppresses the 'could not find ParserDetails.ini in /PerlApp/XML/SAX' warning message in # XML::Simple calls. #$ENV{HARNESS_ACTIVE} = 1; } use strict; use warnings; use Data::Dumper; my $THIS_FILE = "Tools.pm"; ### Methods; # data # environment # _add_hash_reference # _make_hash_reference # _set_defaults # _set_paths use utf8; 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 # somewhat more OO style. I know some may wish to strike me down for this, but I like the idea of accessing # methods via their containing module's name. (A La: C<< $an->Module->method >> rather than C<< $an->method >>). use AN::Tools::Alert; use AN::Tools::Get; use AN::Tools::Log; use AN::Tools::Storage; use AN::Tools::Words; =pod =encoding utf8 =head1 NAME AN::Tools Provides a common oject handle to all AN::Tools::* module methods and handles invocation configuration. =head1 SYNOPSIS use AN::Tools; # Get a common object handle on all AN::Tools::* modules. my $an = AN::Tools->new(); # Again, but this time sets some initial values in the '$an->data' hash. my $an = AN::Tools->new( { data => { foo => "", bar => [], baz => {}, }, }); # This example gets the handle and also sets the default user and log # languages as Japanese, sets a custom log file and sets the log level to # '2'. my $an = AN::Tools->new( { 'Log' => { user_language => "jp", log_language => "jp" level => 2, }, }); =head1 DESCRIPTION The AN::Tools module and all sub-modules are designed for use by Alteeve-based applications. It can be used as a general framework by anyone interested. Core features are; * Supports per user, per logging language selection where translations from from XML-formatted "String" files that support UTF8 and variable substitutions. * Support for command-line and HTML output. Skinning support for HTML-based user interfaces. * Redundant database access, resynchronization and archiving. * Highly-native with minimal use of external perl modules and compiled code. =head1 METHODS Methods in the core module; =cut # The constructor through which all other module's methods will be accessed. sub new { my $class = shift; my $parameter = shift; my $self = { HANDLE => { ALERT => AN::Tools::Alert->new(), GET => AN::Tools::Get->new(), LOG => AN::Tools::Log->new(), STORAGE => AN::Tools::Storage->new(), WORDS => AN::Tools::Words->new(), }, DATA => {}, ERROR_COUNT => 0, ERROR_LIMIT => 10000, DEFAULT => { LANGUAGE => 'en_CA', }, ENV_VALUES => { ENVIRONMENT => 'cli', }, }; # Bless you! bless $self, $class; # This isn't needed, but it makes the code below more consistent with and portable to other modules. my $an = $self; # Get a handle on the various submodules $an->Alert->parent($an); $an->Get->parent($an); $an->Log->parent($an); $an->Storage->parent($an); $an->Words->parent($an); # Set some system paths and system default variables $an->_set_paths; $an->_set_defaults; # This checks the environment this program is running in. $an->environment; # 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}; # Initialize the list of directories to seach. $an->Storage->search_directories({initialize => 1}); # I need to read the initial words early. $an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}); # Set passed parameters if needed. if (ref($parameter) eq "HASH") { ### TODO: Calls to allow the user to override defaults... # Local parameters... } elsif($parameter) { # Um... print $THIS_FILE." ".__LINE__."; AN::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n"; exit(1); } return ($self); } ############################################################################################################# # Public methods # ############################################################################################################# =head2 data This is the method used to access the main hash reference that all user-accessible values are stored in. This includes words, configuration file variables and so forth. When called without an argument, it returns the existing '$an->data' hash reference. my $an = $an->data(); When called with a hash reference as the argument, it sets '$an->data' to the new hash. my $some_hash = {}; my $an = $an->data($some_hash); Data can be entered into or access by treating '$an->data' as a normal hash reference. my $an = AN::Tools->new( { data => { foo => "", bar => [6, 4, 12], baz => { animal => "Cat", thing => "Boat", }, }, }); # Copy the 'Cat' value into the $animal variable. my $animal = $an->data->{baz}{animal}; # Set 'A thing' in 'foo'. $an->data->{foo} = "A thing"; The C<$an> variable is set inside all modules and acts as shared storage for variables, values and references in all modules. It acts as the core storage for most applications using AN::Tools. =cut sub data { my ($an) = shift; # Pick up the passed in hash, if any. $an->{DATA} = shift if $_[0]; return ($an->{DATA}); } =head2 environment This is the method used to check or set whether the program is outputting to command line or a browser. When called without an argument, it returns the current environment. if ($an->environment() eq "cli") { # format for STDOUT } elsif ($an->environment() eq "html") { # Use the template system to output HTML } When called with a string as the argument, that string will be set as the environment string. $an->environment("cli"); Technically, any string can be used, however only 'cli' or 'html' are used by convention. =cut sub environment { my ($an) = shift; # Pick up the passed in delimiter, if any. $an->{ENV_VALUES}{ENVIRONMENT} = shift if $_[0]; return ($an->{ENV_VALUES}{ENVIRONMENT}); } ############################################################################################################# # Public methods used to access sub modules. # ############################################################################################################# =head1 Submodule Access Methods The methods below are used to access methods of submodules using 'C<< $an->Module->method() >>'. =cut =head2 Alert Access the C methods via 'C<< $an->Alert->method >>'. =cut sub Alert { my $self = shift; return ($self->{HANDLE}{ALERT}); } =head2 Get Access the C methods via 'C<< $an->Get->method >>'. =cut sub Get { my $self = shift; return ($self->{HANDLE}{GET}); } =head2 Log Access the C methods via 'C<< $an->Log->method >>'. =cut sub Log { my $self = shift; return ($self->{HANDLE}{LOG}); } =head2 Storage Access the C methods via 'C<< $an->Storage->method >>'. =cut sub Storage { my $self = shift; return ($self->{HANDLE}{STORAGE}); } =head2 Words Access the C methods via 'C<< $an->Words->method >>'. =cut sub Words { my $self = shift; return ($self->{HANDLE}{WORDS}); } =head1 Private Functions; These methods generally should never be called from a program using AN::Tools. However, we are not your boss. =cut ############################################################################################################# # Private methods # ############################################################################################################# =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. NOTE: Contributed by Shaun Fryer and Viktor Pavlenko by way of Toronto Perl Mongers. =cut sub _add_hash_reference { my $self = shift; my $href1 = shift; my $href2 = shift; for my $key (keys %$href2) { if (ref $href1->{$key} eq 'HASH') { $self->_add_hash_reference( $href1->{$key}, $href2->{$key} ); } else { $href1->{$key} = $href2->{$key}; } } } =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 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. 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) { 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 => { # Default language for all output shown to a user. 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, }, 'log' => { db_transactions => 0, language => "en_CA", level => 1, pid => 0, secure => 0, }, }; return(0); } =head2 _set_paths This sets default paths to many system commands, checking to make sure the binary exists at the path and, if not, try to find it. =cut sub _set_paths { my ($an) = shift; # Executables $an->data->{path} = { exe => { gethostip => "/usr/bin/gethostip", hostname => "/bin/hostname", }, logs => { 'an-tools.log' => "/var/log/an-tools.log", }, words => { 'an-tools.xml' => "/usr/share/perl5/AN/an-tools.xml", }, }; # Make sure we actually have the requested files. foreach my $type (sort {$a cmp $b} keys %{$an->data->{path}}) { # We don't look for logs because we'll create them if they don't exist. next if $type eq "logs"; foreach my $file (sort {$a cmp $b} keys %{$an->data->{path}{$type}}) { if (not -e $an->data->{path}{$type}{$file}) { my $fatal = 0; if ($type eq "words") { # We have to die if we don't find a words file. $fatal = 1; } my $full_path = $an->Storage->find({ file => $file, fatal => $fatal, }); if ($full_path) { $an->data->{path}{$type}{$file} = $full_path; } } } } return(0); } =head1 Exit Codes =head2 C<1> AN::Tools->new() passed something other than a hash reference. =head2 C<2> Failed to find the requested file in C<< AN::Tools::Storage->find >> and 'fatal' was set. =head1 Requirements The following packages are required on EL7. * C * C * C * C * C * C * C * C =head1 Recommended Packages The following packages provide non-critical functionality. * C =cut 1;