Source AN::Tools

From AN!Wiki
Jump to: navigation, search

 AN!Tools :: AN::Tools :: Source AN::Tools

Tools.pm

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.
Us: Alteeve's Niche! Support: Mailing List IRC: #clusterlabs on Freenode   © Alteeve's Niche! Inc. 1997-2019
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.
Personal tools
Namespaces

Variants
Actions
Navigation
projects
Toolbox