Source AN::Tools
Jump to navigation
Jump to search
package AN::Tools;
# This is the "root" package that manages the sub modules and controls access
# to their methods.
#
# Dedicated to Leah Kubik who helped me back in the early days of TLE-BU.
#
BEGIN
{
push @INC, '.';
}
use strict;
use warnings;
our $VERSION=0.0.001;
my $THIS_FILE="Tools.pm";
# Setup for UTF-8 mode.
use utf8;
$ENV{'PERL_UNICODE'}=1;
# 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: $an->Module->method rather than
# $an->method).
use AN::Tools::Alert;
use AN::Tools::Math;
use AN::Tools::Readable;
use AN::Tools::String;
# The constructor through which all other module's methods will be accessed.
sub new
{
my $class=shift;
my $param=shift;
my $self={
HANDLE => {
ALERT => AN::Tools::Alert->new(),
MATH => AN::Tools::Math->new(),
READABLE => AN::Tools::Readable->new(),
STRING => AN::Tools::String->new(),
},
LOADED => {
'Math::BigInt' => 0,
'IO::Handle' => 0,
},
DATA => {},
ERROR_LIMIT => 10000,
};
bless $self, $class;
# This gets handles to my other modules that the child modules will use
# to talk to other sibling modules.
$self->Alert->parent($self);
$self->Math->parent($self);
$self->Readable->parent($self);
$self->String->parent($self);
# Set passed parameters if needed.
if (ref($param) eq "HASH")
{
### AN::Tools::String parameters
# Force UTF-8.
$self->String->force_utf8($param->{String}{force_utf8}) if defined $param->{String}{force_utf8};
}
# Call methods that need to be loaded at invocation of the module.
$self->String->read_words();
return ($self);
}
# This is a shortcut to the '$an->Alert->_error_string' method allowing for
# '$an->error' to be called, saving the caller typing.
sub error
{
my $self=shift;
return ($self->Alert->_error_string);
}
# This is a shortcut to the '$an->Alert->_error_code' method allowing for
# '$an->error_code' to be called, saving the caller typing.
sub error_code
{
my $self=shift;
return ($self->Alert->_error_code);
}
# Makes my handle to AN::Tools::Alert clearer when using this module to access
# it's methods.
sub Alert
{
my $self=shift;
return ($self->{HANDLE}{ALERT});
}
# 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.
sub data
{
my $self=shift;
return ($self->{DATA});
}
# Makes my handle to AN::Tools::Math clearer when using this module to access
# it's methods.
sub Math
{
my $self=shift;
return ($self->{HANDLE}{MATH});
}
# Makes my handle to AN::Tools::Readable clearer when using this module to
# access it's methods.
sub Readable
{
my $self=shift;
return ($self->{HANDLE}{READABLE});
}
# Makes my handle to AN::Tools::String clearer when using this module to
# access it's methods.
sub String
{
my $self=shift;
return ($self->{HANDLE}{STRING});
}
# This simply sets and/or returns the internal variable that records when the
# Math::BigInt module has been loaded.
sub _math_bigint_loaded
{
my $self=shift;
my $set=$_[0] ? shift : undef;
$self->{LOADED}{'Math::BigInt'}=$set if defined $set;
return ($self->{LOADED}{'Math::BigInt'});
}
# This loads the 'Math::BigInt' module.
sub _load_math_bigint
{
my $self=shift;
eval 'use Math::BigInt;';
if ($@)
{
$self->Alert->error({
fatal => 1,
title => "'AN::Tools' tried to load the 'Math::BigInt' module but it does not seem to be available.",
message => "Loading the perl module 'Math::BigInt' failed with the error: [$@].",
code => 9,
file => "$THIS_FILE",
line => __LINE__
});
# Return nothing in case the user is blocking fatal
# errors.
return (undef);
}
else
{
# Good, record it as loaded.
$self->_math_bigint_loaded(1);
}
return(0);
}
# This simply sets and/or returns the internal variable that records when the
# IO::Handle module has been loaded.
sub _io_handle_loaded
{
my $self=shift;
my $set=$_[0] ? shift : undef;
$self->{LOADED}{'IO::Handle'}=$set if defined $set;
return ($self->{LOADED}{'IO::Handle'});
}
# When a method may possibly loop indefinately, it checks an internal counter
# against the value returned here and kills the program when reached.
sub _error_limit
{
my $self=shift;
return ($self->{ERROR_LIMIT});
}
# This loads the 'Math::BigInt' module.
sub _load_io_handle
{
my $self=shift;
eval 'use IO::Handle;';
if ($@)
{
$self->Alert->error({
fatal => 1,
title => "'AN::Tools' tried to load the 'IO::Handle' module but it does not seem to be available.",
message => "Loading the perl module 'IO::Handle' failed with the error: [$@].",
code => 13,
file => "$THIS_FILE",
line => __LINE__
});
# Return nothing in case the user is blocking fatal
# errors.
return (undef);
}
else
{
# Good, record it as loaded.
$self->_io_handle_loaded(1);
}
return(0);
}
### Contributed by Shaun Fryer and Viktor Pavlenko by way of TPM.
# 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.
sub _make_hash_reference
{
my $self=shift;
my $href=shift;
my $key_string=shift;
my $value=shift;
if ($self->{CHOMP_ROOT}) { $key_string=~s/\w+:://; }
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);
}
### Contributed by Shaun Fryer and Viktor Pavlenko by way of TPM.
# This is a helper to the above '_add_href' method. It is called each time a
# new string is to be created as a new hash key in the passed hash reference.
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};
}
}
}
# This is called when I need to parse a double-colon seperated string into two
# or more elements which represent keys in the 'conf' hash. Once suitably split
# up, the 'value' is read. For example, passing ('conf', 'foo::bar') will
# return the previously-set value 'baz'.
sub _get_hash_reference
{
# 'href' is the hash reference I am working on.
my $self=shift;
my $param=shift;
die "I didn't get a hash key string, so I can't pull hash reference pointer.\n" if ref($param->{key}) ne "HASH";
die "The hash key string: [$param->{key}] doesn't seem to be valid. It should be a string in the format 'foo::bar::baz'.\n" if $param->{key} !~ /::/;
# Split up the keys.
my @keys=split /::/, $param->{key};
my $last_key=pop @keys;
# Re-order the array.
my $_chref=$self->data;
foreach my $key (@keys)
{
$_chref=$_chref->{$key};
}
return ($_chref->{$last_key});
}
1;
| Any questions, feedback, advice, complaints or meanderings are welcome. | |||
| Alteeve's Niche! | Enterprise Support: Alteeve Support |
Community Support | |
| © Alteeve's Niche! Inc. 1997-2024 | Anvil! "Intelligent Availability®" Platform | ||
| legal stuff: All info is provided "As-Is". Do not use anything here unless you are willing and able to take responsibility for your own actions. | |||