* Added the new AN::Log and AN::Get modules.

* Added Get->date_and_time() method.
* Added the 'initialize' parameter to Storage->search_directories() to have a cleaner way of initializing the search directories.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 8 years ago
parent 7b8cb22de0
commit dd4fb49e6c
  1. 46
      AN/Tools.pm
  2. 29
      AN/Tools.t
  3. 2
      AN/Tools/Alert.pm
  4. 163
      AN/Tools/Get.pm
  5. 188
      AN/Tools/Log.pm
  6. 20
      AN/Tools/Storage.pm
  7. 2
      AN/Tools/Words.pm

@ -32,6 +32,8 @@ binmode(STDOUT, ':encoding(utf-8)');
# 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;
@ -99,6 +101,8 @@ sub new
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(),
},
@ -121,6 +125,8 @@ sub new
# 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);
@ -134,9 +140,8 @@ sub new
# 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};
# Set my search directory to @INC + $ENV{'PATH'}, minus directories that don't exist. We trigger this
# build by passing in an empty directory list.
$an->Storage->search_directories({directories => 1});
# 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'}});
@ -262,6 +267,30 @@ sub Alert
return ($self->{HANDLE}{ALERT});
}
=head2 Get
Access the C<Get.pm> methods via 'C<< $an->Get->method >>'.
=cut
sub Get
{
my $self = shift;
return ($self->{HANDLE}{GET});
}
=head2 Log
Access the C<Log.pm> methods via 'C<< $an->Log->method >>'.
=cut
sub Log
{
my $self = shift;
return ($self->{HANDLE}{LOG});
}
=head2 Storage
Access the C<Storage.pm> methods via 'C<< $an->Storage->method >>'.
@ -412,8 +441,6 @@ sub _set_defaults
$an->data->{defaults} = {
languages => {
# Default log langauge.
'log' => 'en_CA',
# Default language for all output shown to a user.
output => 'en_CA',
},
@ -421,7 +448,14 @@ sub _set_defaults
# 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);

@ -10,7 +10,7 @@ use utf8;
our $VERSION="3.0.0";
# Call in the test module, telling it how many tests to expect to run.
use Test::More tests => 30;
use Test::More tests => 39;
# Load my module via 'use_ok' test.
BEGIN
@ -68,7 +68,7 @@ is($an->Storage->read_config({ file => "AN/moo.conf" }), 2, "Verifying that '\$a
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.");
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
@ -117,4 +117,27 @@ is($an->Words->string({
ここでt_0000を挿入します[テスト いれかえる: [result!]]
ここでは t_0002に埋め込み変数を挿入しますテスト 整理: [2nd]/[1st]
ここでは変数 この文字列にはt_0001が埋め込まれていますテスト いれかえる: [result!]を持つ t_0001を注入する t_0006を注入します
", "Verifying string processing in Japanese.")
", "Verifying string processing in Japanese.");
### Get tests.
like($an->Get->date_and_time(), qr/^\d\d\d\d\/\d\d\/\d\d \d\d:\d\d:\d\d$/, "Verifying the current date and time is returned.");
like($an->Get->date_and_time({date_only => 1}), qr/^\d\d\d\d\/\d\d\/\d\d$/, "Verifying the current date alone is returned.");
like($an->Get->date_and_time({time_only => 1}), qr/^\d\d:\d\d:\d\d$/, "Verifying the current time alone is returned.");
like($an->Get->date_and_time({file_name => 1}), qr/^\d\d\d\d-\d\d-\d\d_\d\d-\d\d-\d\d$/, "Verifying the current date and time is returned in a file-friendly format.");
like($an->Get->date_and_time({file_name => 1, date_only => 1}), qr/^\d\d\d\d-\d\d-\d\d$/, "Verifying the current date only is returned in a file-friendly format.");
like($an->Get->date_and_time({file_name => 1, time_only => 1}), qr/^\d\d-\d\d-\d\d$/, "Verifying the current time only is returned in a file-friendly format.");
# We can't be too specific because the user's TZ will shift the results
like($an->Get->date_and_time({use_time => 1234567890}), qr/2009\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime returned the expected date.");
like($an->Get->date_and_time({use_time => 1234567890, offset => 31536000}), qr/2010\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the future offset returned the expected date.");
like($an->Get->date_and_time({use_time => 1234567890, offset => -31536000}), qr/2008\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the past offset returned the expected date.");
# my $time = time;
# print "Current time: .............. [".$an->Get->date_and_time({})."]\n";
# print "Current time only: ......... [".$an->Get->date_and_time({time_only => 1})."]\n";
# print "Current date only: ......... [".$an->Get->date_and_time({date_only => 1})."]\n";
# print "Current file time: ......... [".$an->Get->date_and_time({file_name => 1})."]\n";
# print "Current file time only: .... [".$an->Get->date_and_time({file_name => 1, time_only => 1})."]\n";
# print "Current file date only: .... [".$an->Get->date_and_time({file_name => 1, date_only => 1})."]\n";
# print "One hour ago: .............. [".$an->Get->date_and_time({offset => -3600})."]\n";
# print "Ten hours from now: ........ [".$an->Get->date_and_time({offset => 36000})."]\n";
# print "Ten hours ago: ............. [".$an->Get->date_and_time({offset => -36000})."]\n";

@ -24,7 +24,7 @@ Provides all methods related warnings and alerts.
=head1 SYNOPSIS
use AN::Tools::Alert;
use AN::Tools;
# Get a common object handle on all AN::Tools modules.
my $an = AN::Tools->new();

@ -0,0 +1,163 @@
package AN::Tools::Get;
#
# This module contains methods used to handle access to frequently used data.
#
use strict;
use warnings;
use Data::Dumper;
our $VERSION = "3.0.0";
my $THIS_FILE = "Get.pm";
### Methods;
# date_and_time
=pod
=encoding utf8
=head1 NAME
AN::Tools::Get
Provides all methods related to logging.
=head1 SYNOPSIS
use AN::Tools;
# Get a common object handle on all AN::Tools modules.
my $an = AN::Tools->new();
# Access to methods using '$an->Get->X'.
#
# Example using 'date_and_time()';
my $foo_path = $an->Get->date_and_time({...});
=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 date_and_time
This method returns the date and/or time using either the current time, or a specified unix time.
NOTE: This only returns times in 24-hour notation.
=head2 Parameters;
=head3 date_only (optional)
If set, only the date will be returned (in C<< yyyy/mm/dd >> format).
=head3 file_name (optional)
When set, the date and/or time returned in a string more useful in file names. Specifically, it will replace spaces with 'C<< _ >>' and 'C<< : >>' and 'C<< / >>' for 'C<< - >>'. This will result in a string in the format like 'C<< yyyy-mm-dd_hh-mm-ss >>'.
=head3 offset (optional)
If set to a signed number, it will add or subtract the number of seconds from the 'C<< use_time >>' before processing.
=head3 use_time (optional)
This can be set to a unix timestamp. If it is not set, the current time is used.
=head3 time_only (optional)
If set, only the time will be returned (in C<< hh:mm:ss >> format).
=cut
sub date_and_time
{
my $self = shift;
my $parameter = shift;
my $an = $self->parent;
my $offset = defined $parameter->{offset} ? $parameter->{offset} : 0;
my $use_time = defined $parameter->{use_time} ? $parameter->{use_time} : time;
my $file_name = defined $parameter->{file_name} ? $parameter->{file_name} : 0;
my $time_only = defined $parameter->{time_only} ? $parameter->{time_only} : 0;
my $date_only = defined $parameter->{date_only} ? $parameter->{date_only} : 0;
# Are things sane?
if ($use_time =~ /D/)
{
die "Get->date_and_time() was called with 'use_time' set to: [$use_time]. Only a unix timestamp is allowed.\n";
}
if ($offset =~ /D/)
{
die "Get->date_and_time() was called with 'offset' set to: [$offset]. Only real number is allowed.\n";
}
# Do my initial calculation.
my $return_string = "";
my $time = {};
my $adjusted_time = $use_time + $offset;
#print $THIS_FILE." ".__LINE__."; [ Debug ] - adjusted_time: [$adjusted_time]\n";
# Get the date and time pieces
($time->{sec}, $time->{min}, $time->{hour}, $time->{mday}, $time->{mon}, $time->{year}, $time->{wday}, $time->{yday}, $time->{isdst}) = localtime($adjusted_time);
#print $THIS_FILE." ".__LINE__."; [ Debug ] - time->{sec}: [".$time->{sec}."], time->{min}: [".$time->{min}."], time->{hour}: [".$time->{hour}."], time->{mday}: [".$time->{mday}."], time->{mon}: [".$time->{mon}."], time->{year}: [".$time->{year}."], time->{wday}: [".$time->{wday}."], time->{yday}: [".$time->{yday}."], time->{isdst}: [".$time->{isdst}."]\n";
# Process the raw data
$time->{pad_hour} = sprintf("%02d", $time->{hour});
$time->{mon}++;
$time->{pad_min} = sprintf("%02d", $time->{min});
$time->{pad_sec} = sprintf("%02d", $time->{sec});
$time->{year} = ($time->{year} + 1900);
$time->{pad_mon} = sprintf("%02d", $time->{mon});
$time->{pad_mday} = sprintf("%02d", $time->{mday});
#print $THIS_FILE." ".__LINE__."; [ Debug ] - time->{pad_hour}: [".$time->{pad_hour}."], time->{pad_min}: [".$time->{pad_min}."], time->{pad_sec}: [".$time->{pad_sec}."], time->{year}: [".$time->{year}."], time->{pad_mon}: [".$time->{pad_mon}."], time->{pad_mday}: [".$time->{pad_mday}."], time->{mon}: [".$time->{mon}."]\n";
# Now, the date and time separator depends on if 'file_name' is set.
my $date_separator = $file_name ? "-" : "/";
my $time_separator = $file_name ? "-" : ":";
my $space_separator = $file_name ? "_" : " ";
if ($time_only)
{
$return_string = $time->{pad_hour}.$time_separator.$time->{pad_min}.$time_separator.$time->{pad_sec};
#print $THIS_FILE." ".__LINE__."; [ Debug ] - return_string: [$return_string]\n";
}
elsif ($date_only)
{
$return_string = $time->{year}.$date_separator.$time->{pad_mon}.$date_separator.$time->{pad_mday};
#print $THIS_FILE." ".__LINE__."; [ Debug ] - return_string: [$return_string]\n";
}
else
{
$return_string = $time->{year}.$date_separator.$time->{pad_mon}.$date_separator.$time->{pad_mday}.$space_separator.$time->{pad_hour}.$time_separator.$time->{pad_min}.$time_separator.$time->{pad_sec};
#print $THIS_FILE." ".__LINE__."; [ Debug ] - return_string: [$return_string]\n";
}
return($return_string);
}

@ -0,0 +1,188 @@
package AN::Tools::Log;
#
# This module contains methods used to handle logging related tasks
#
use strict;
use warnings;
use Data::Dumper;
our $VERSION = "3.0.0";
my $THIS_FILE = "Log.pm";
### Methods;
# entry
=pod
=encoding utf8
=head1 NAME
AN::Tools::Log
Provides all methods related to logging.
=head1 SYNOPSIS
use AN::Tools;
# Get a common object handle on all AN::Tools modules.
my $an = AN::Tools->new();
# Access to methods using '$an->Log->X'.
#
# Example using 'entry()';
my $foo_path = $an->Log->entry({...});
=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 entry
This method writes an entry to the log file, provided the log file is equal to or higher than the active log level. The exception is if the log entry contains sensitive data, like a password, and 'C<< log::secure >> is set to 'C<< 0 >>' (the default).
Here is a simple example of writing a simple log entry at log log level 1.
$an->Log->entry({file => $THIS_FILE, line => __LINE__, level => 1, key => "log_0001"});
In the example above, the string will be written to the log file if the active log level is 'C<< 1 >>' or higher and it will use the 'C<< log::language >>' language to translate the string key.
Now a more complex example;
$an->Log->entry({
file => $THIS_FILE,
line => __LINE__,
level => 2,
secure => 1,
language => "jp",
key => "log_0002",
variables => {
password => "foo",
},
});
In the above example, the log level is set to 'C<< 2 >>' and the 'C<< secure >>' flag is set. We're also logging in Japanese and we are passing a variable into the string key. With the secure flag set, even if the user's log level is 2 or higher, the log entry will only be recorded if the user has set 'C<< log::secure >>' to '1'.
Finally, it is possible to log pre-processed strings (as is done in 'Alert->warning()' and 'Alert->error()'). In this case, the 'C<< raw >>' parameter is used and it contains the processed string. Note that the source file and line number are still pre-pended to the raw message.
$an->Log->entry({
file => $THIS_FILE,
line => __LINE__,
level => 2,
raw => "This error can't be translated",
});
The above should be used very sparingly, and generally only in places where string processing itself is being logged.
Parameters;
=head3 file (optional)
When set, the string is pre-pended to the log entry. This is generally set to 'C<< $THIS_FILE >>', which itself should contain the file name requesting the log entry.
=head3 key (required)
NOTE: This is not required *if* 'C<< raw >>' is used instead.
This is the string key to use for the log entry. By default, it will be translated into the 'C<< log::language >> language. If the string contains replacement variables, be sure to also use 'C<< variables >>'.
=head3 level (required)
This is the numeric log level of this log entry. It determines if the message is of interest to the user. An entry is only recorded if the user's 'C<< log::level >>' is equal to or higher than this number. This is required, but if it is not passed, 'C<< 2 >>' will be used.
NOTE: The 'C<< log::level >>' might be changed inside certain programs. For example, in ScanCore, the user may set 'C<< scancore::log::level >>' and that will be used to set 'C<< log::level >>'.
Log levels are:
=head4 C<< 0 >>
Critical messages. These will always be logged, and so this log level should very rarely be used. Generally it will be used only by Alert->warning() and Alert->error().
=head4 C<< 1 >>
Important messages. The default log level is 'C<< 1 >>', so anything at this log level will usually be logged under normal conditions.
=head4 C<< 2 >>
This is the 'debug' log level. It is used by developers while working on a section of code, or in places where the log entries can help in general debugging.
=head4 C<< 3 >>
This is the 'verbose' log level. It will generally generate a significant amount of output and is generally used for most logging. A user will generally only set this log level when trying to debug a problem with an unknown source.
=head4 C<< 4 >>
This is the highest log level, and it will generate a tremendous amount of log entries. This is generally used is loops or recursive functions where the output is significant, but the usefulness of the output is not.
=head3 line (optional)
When set, the string is prepended to the log entry, after 'C<< file >> if set, and should be set to C<< __LINE__ >>. It is used to show where in 'C<< file >>' the log entry was made and can assist with debugging.
=head3 raw (optional)
NOTE: This *or* C<< key >> must be passed.
This can contain a string to record to the log file. It is treated as a raw string and is not translated, altered or processed in any way. It will be recorded exactly as-is, provided the log level and secure settings allow for it.
=head3 secure (optional)
When set, this indicates that the log entry might contain sensitive data, like a password. When set, the log entry will only be recorded if 'C<< log::secure >>' is set to '1' *and* the log level is equal to or higher than 'C<< log::level >>'.
=head3 variables (optional)
This is a hash reference containing replacement variables to inject into the 'C<< key >>' string.
=cut
sub entry
{
my $self = shift;
my $parameter = shift;
my $an = $self->parent;
my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $key = defined $parameter->{key} ? $parameter->{key} : "";
my $level = defined $parameter->{level} ? $parameter->{level} : 2;
my $line = defined $parameter->{line} ? $parameter->{line} : "";
my $raw = defined $parameter->{raw} ? $parameter->{raw} : "";
my $secure = defined $parameter->{secure} ? $parameter->{secure} : 0;
my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
if ($level > $an->data->{'log'}{level})
{
return(1);
}
return(0);
}

@ -27,7 +27,7 @@ Provides all methods related to storage on a system.
=head1 SYNOPSIS
use AN::Tools::Storage;
use AN::Tools;
# Get a common object handle on all AN::Tools modules.
my $an = AN::Tools->new();
@ -298,6 +298,12 @@ This accepts either an array reference of directories to search, or a comma-sepa
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.
=head3 initialize (optional)
If this is set, the list of directories to search will be set to '@INC + $ENV{'PATH'}'.
NOTE: You don't need to call this manually unless you want to reset the list. Invoking AN::Tools->new() causes this to be called automatically.
=cut
sub search_directories
{
@ -306,7 +312,8 @@ sub search_directories
my $an = $self->parent;
# Set a default if nothing was passed.
my $array = defined $parameter->{directories} ? $parameter->{directories} : "";
my $array = defined $parameter->{directories} ? $parameter->{directories} : "";
my $initialize = defined $parameter->{initialize} ? $parameter->{initialize} : "";
# If the array is a CSV of directories, convert it now.
if ($array =~ /,/)
@ -315,10 +322,13 @@ sub search_directories
my @new_array = split/,/, $array;
$array = \@new_array;
}
elsif (($array) && (ref($array) ne "ARRAY"))
elsif (($initialize) or (($array) && (ref($array) ne "ARRAY")))
{
# TODO: Make this a $an->Alert->warning().
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";
if (not $initialize)
{
# TODO: Make this a $an->Alert->warning().
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";
}
# Create a new array containing the '$ENV{'PATH'}' directories and the @INC directories.
my @new_array = split/:/, $ENV{'PATH'} if $ENV{'PATH'} =~ /:/;

@ -33,7 +33,7 @@ Provides all methods related to generating translated strings for users.
=head1 SYNOPSIS
use AN::Tools::Words;
use AN::Tools;
# Get a common object handle on all AN::Tools modules.
my $an = AN::Tools->new();

Loading…
Cancel
Save