** Major Changes **

We've decided to give up on trying to keep ScanCore, AN::Tools and Striker as three separate things. We had originally hoped to make ScanCore easily separatable from the Anvil!, but this was adding increasing complexity to the project and complexity is the enemy of reliability.

In this release, AN::Tools becomes Anvil::Tools, all configuration files move to /etc/anvil and all programs and data files move to /usr/sbin/anvil. Words files are now merged, as are SQL schemas (ScanCore agents will still maintain their own, later). The journald tag has changed from 'an-tools' to 'anvil'.

Other changes;
* Tools.t has been updated to handle existing tests. New methods and parameters still need to have tests added though.
* Added a simple test.pl script used for testing things outside the main program. It will be removed before final release.
* Added the simple 'watch_logs' bash script to more easily tail output.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 7 years ago
parent ee7b68bfb5
commit 1cb42080c3
  1. 599
      AN/Tools.t
  2. 274
      Anvil/Tools.pm
  3. 0
      Anvil/Tools.sql
  4. 604
      Anvil/Tools.t
  5. 200
      Anvil/Tools/Alert.pm
  6. 98
      Anvil/Tools/Convert.pm
  7. 1618
      Anvil/Tools/Database.pm
  8. 186
      Anvil/Tools/Get.pm
  9. 167
      Anvil/Tools/Log.pm
  10. 242
      Anvil/Tools/Storage.pm
  11. 568
      Anvil/Tools/System.pm
  12. 107
      Anvil/Tools/Template.pm
  13. 158
      Anvil/Tools/Validate.pm
  14. 106
      Anvil/Tools/Words.pm
  15. 22
      Anvil/anvil-tools.xml
  16. 2
      Anvil/test.conf
  17. 4
      Anvil/tools.conf
  18. 116
      anvil.conf
  19. 796
      cgi-bin/home
  20. 100
      cgi-bin/words.xml
  21. 6
      notes
  22. 227
      scancore.sql
  23. 32
      striker.conf
  24. 15
      test.pl
  25. 373
      tools/an-prep-database
  26. 101
      tools/anvil-daemon
  27. 370
      tools/anvil-prep-database
  28. 70
      tools/anvil-update-states
  29. 230
      tools/anvil.sql
  30. 87
      tools/scancore-daemon
  31. 98
      tools/words.xml
  32. 4
      units/anvil-daemon.service
  33. 1
      watch_logs

@ -1,599 +0,0 @@
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use utf8;
# Be nice and set a version number.
our $VERSION = "3.0.0";
our $THIS_FILE = "Tools.t";
# Call in the test module, telling it how many tests to expect to run.
use Test::More tests => 199;
# Load my module via 'use_ok' test.
BEGIN
{
print "Beginning tests of the AN::Tools suite of modules.\n";
use_ok('AN::Tools', 3.0.0);
}
### Core tests
my $an = AN::Tools->new();
like($an, qr/^AN::Tools=HASH\(0x\w+\)$/, "Verifying that AN::Tools object is valid.");
like($an->data, qr/^HASH\(0x\w+\)$/, "Verifying that 'data' is a hash reference.");
is($an->environment, "cli", "Verifying that environment initially reports 'cli'.");
$an->environment('html');
is($an->environment, "html", "Verifying that environment was properly set to 'html'.");
$an->environment('cli');
is($an->environment, "cli", "Verifying that environment was properly reset back to 'cli'.");
# Test handles to child modules.
like($an->Alert, qr/^AN::Tools::Alert=HASH\(0x\w+\)$/, "Verifying that 'Alert' is a handle to AN::Tools::Alert.");
like($an->Convert, qr/^AN::Tools::Convert=HASH\(0x\w+\)$/, "Verifying that 'Convert' is a handle to AN::Tools::Convert.");
like($an->Database, qr/^AN::Tools::Database=HASH\(0x\w+\)$/, "Verifying that 'Database' is a handle to AN::Tools::Database.");
like($an->Get, qr/^AN::Tools::Get=HASH\(0x\w+\)$/, "Verifying that 'Get' is a handle to AN::Tools::Get.");
like($an->Log, qr/^AN::Tools::Log=HASH\(0x\w+\)$/, "Verifying that 'Log' is a handle to AN::Tools::Log.");
like($an->Storage, qr/^AN::Tools::Storage=HASH\(0x\w+\)$/, "Verifying that 'Storage' is a handle to AN::Tools::Storage.");
like($an->System, qr/^AN::Tools::System=HASH\(0x\w+\)$/, "Verifying that 'System' is a handle to AN::Tools::System.");
like($an->Template, qr/^AN::Tools::Template=HASH\(0x\w+\)$/, "Verifying that 'Template' is a handle to AN::Tools::Template.");
like($an->Validate, qr/^AN::Tools::Validate=HASH\(0x\w+\)$/, "Verifying that 'Validate' is a handle to AN::Tools::Validate.");
like($an->Words, qr/^AN::Tools::Words=HASH\(0x\w+\)$/, "Verifying that 'Words' is a handle to AN::Tools::Words.");
### Special
# We log a note telling the user to ignore log entries caused by this test suite. We'll then read it back and
# make sure it logged properly
$an->Log->entry({level => 0, priority => "alert", key => "log_0048"});
my $message = $an->Words->string({key => "log_0048"});
my $last_log = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($last_log, $message, "Verified that we could write a log entry to journalctl by warning the user of incoming warnings and errors.");
### AN::Tools::Alert tests
# <none yet>
### AN::Tools::Convert tests
# cidr tests
is($an->Convert->cidr({cidr => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'cidr' parameter.");
is($an->Convert->cidr({cidr => "0"}), "0.0.0.0", "Verifying that Convert->cidr properly returned '0.0.0.0' when given a 'cidr' parameter of '0'.");
is($an->Convert->cidr({cidr => "1"}), "128.0.0.0", "Verifying that Convert->cidr properly returned '128.0.0.0' when given a 'cidr' parameter of '1'.");
is($an->Convert->cidr({cidr => "2"}), "192.0.0.0", "Verifying that Convert->cidr properly returned '192.0.0.0' when given a 'cidr' parameter of '2'.");
is($an->Convert->cidr({cidr => "3"}), "224.0.0.0", "Verifying that Convert->cidr properly returned '224.0.0.0' when given a 'cidr' parameter of '3'.");
is($an->Convert->cidr({cidr => "4"}), "240.0.0.0", "Verifying that Convert->cidr properly returned '240.0.0.0' when given a 'cidr' parameter of '4'.");
is($an->Convert->cidr({cidr => "5"}), "248.0.0.0", "Verifying that Convert->cidr properly returned '248.0.0.0' when given a 'cidr' parameter of '5'.");
is($an->Convert->cidr({cidr => "6"}), "252.0.0.0", "Verifying that Convert->cidr properly returned '252.0.0.0' when given a 'cidr' parameter of '6'.");
is($an->Convert->cidr({cidr => "7"}), "254.0.0.0", "Verifying that Convert->cidr properly returned '254.0.0.0' when given a 'cidr' parameter of '7'.");
is($an->Convert->cidr({cidr => "8"}), "255.0.0.0", "Verifying that Convert->cidr properly returned '255.0.0.0' when given a 'cidr' parameter of '8'.");
is($an->Convert->cidr({cidr => "9"}), "255.128.0.0", "Verifying that Convert->cidr properly returned '255.128.0.0' when given a 'cidr' parameter of '9'.");
is($an->Convert->cidr({cidr => "10"}), "255.192.0.0", "Verifying that Convert->cidr properly returned '255.192.0.0' when given a 'cidr' parameter of '10'.");
is($an->Convert->cidr({cidr => "11"}), "255.224.0.0", "Verifying that Convert->cidr properly returned '255.224.0.0' when given a 'cidr' parameter of '11'.");
is($an->Convert->cidr({cidr => "12"}), "255.240.0.0", "Verifying that Convert->cidr properly returned '255.240.0.0' when given a 'cidr' parameter of '12'.");
is($an->Convert->cidr({cidr => "13"}), "255.248.0.0", "Verifying that Convert->cidr properly returned '255.248.0.0' when given a 'cidr' parameter of '13'.");
is($an->Convert->cidr({cidr => "14"}), "255.252.0.0", "Verifying that Convert->cidr properly returned '255.252.0.0' when given a 'cidr' parameter of '14'.");
is($an->Convert->cidr({cidr => "15"}), "255.254.0.0", "Verifying that Convert->cidr properly returned '255.254.0.0' when given a 'cidr' parameter of '15'.");
is($an->Convert->cidr({cidr => "16"}), "255.255.0.0", "Verifying that Convert->cidr properly returned '255.255.0.0' when given a 'cidr' parameter of '16'.");
is($an->Convert->cidr({cidr => "17"}), "255.255.128.0", "Verifying that Convert->cidr properly returned '255.255.128.0' when given a 'cidr' parameter of '17'.");
is($an->Convert->cidr({cidr => "18"}), "255.255.192.0", "Verifying that Convert->cidr properly returned '255.255.192.0' when given a 'cidr' parameter of '18'.");
is($an->Convert->cidr({cidr => "19"}), "255.255.224.0", "Verifying that Convert->cidr properly returned '255.255.224.0' when given a 'cidr' parameter of '19'.");
is($an->Convert->cidr({cidr => "20"}), "255.255.240.0", "Verifying that Convert->cidr properly returned '255.255.240.0' when given a 'cidr' parameter of '20'.");
is($an->Convert->cidr({cidr => "21"}), "255.255.248.0", "Verifying that Convert->cidr properly returned '255.255.248.0' when given a 'cidr' parameter of '21'.");
is($an->Convert->cidr({cidr => "22"}), "255.255.252.0", "Verifying that Convert->cidr properly returned '255.255.252.0' when given a 'cidr' parameter of '22'.");
is($an->Convert->cidr({cidr => "23"}), "255.255.254.0", "Verifying that Convert->cidr properly returned '255.255.254.0' when given a 'cidr' parameter of '23'.");
is($an->Convert->cidr({cidr => "24"}), "255.255.255.0", "Verifying that Convert->cidr properly returned '255.255.255.0' when given a 'cidr' parameter of '24'.");
is($an->Convert->cidr({cidr => "25"}), "255.255.255.128", "Verifying that Convert->cidr properly returned '255.255.255.128' when given a 'cidr' parameter of '25'.");
is($an->Convert->cidr({cidr => "26"}), "255.255.255.192", "Verifying that Convert->cidr properly returned '255.255.255.192' when given a 'cidr' parameter of '26'.");
is($an->Convert->cidr({cidr => "27"}), "255.255.255.224", "Verifying that Convert->cidr properly returned '255.255.255.224' when given a 'cidr' parameter of '27'.");
is($an->Convert->cidr({cidr => "28"}), "255.255.255.240", "Verifying that Convert->cidr properly returned '255.255.255.240' when given a 'cidr' parameter of '28'.");
is($an->Convert->cidr({cidr => "29"}), "255.255.255.248", "Verifying that Convert->cidr properly returned '255.255.255.248' when given a 'cidr' parameter of '29'.");
is($an->Convert->cidr({cidr => "30"}), "255.255.255.252", "Verifying that Convert->cidr properly returned '255.255.255.252' when given a 'cidr' parameter of '30'.");
is($an->Convert->cidr({cidr => "31"}), "255.255.255.254", "Verifying that Convert->cidr properly returned '255.255.255.254' when given a 'cidr' parameter of '31'.");
is($an->Convert->cidr({cidr => "32"}), "255.255.255.255", "Verifying that Convert->cidr properly returned '255.255.255.255' when given a 'cidr' parameter of '32'.");
is($an->Convert->cidr({subnet => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'subnet' parameter.");
is($an->Convert->cidr({subnet => "0.0.0.0"}), "0", "Verifying that Convert->cidr properly returned '0' when given a 'subnet' parameter of '0.0.0.0'.");
is($an->Convert->cidr({subnet => "128.0.0.0"}), "1", "Verifying that Convert->cidr properly returned '1' when given a 'subnet' parameter of '128.0.0.0'.");
is($an->Convert->cidr({subnet => "192.0.0.0"}), "2", "Verifying that Convert->cidr properly returned '2' when given a 'subnet' parameter of '192.0.0.0'.");
is($an->Convert->cidr({subnet => "224.0.0.0"}), "3", "Verifying that Convert->cidr properly returned '3' when given a 'subnet' parameter of '224.0.0.0'.");
is($an->Convert->cidr({subnet => "240.0.0.0"}), "4", "Verifying that Convert->cidr properly returned '4' when given a 'subnet' parameter of '240.0.0.0'.");
is($an->Convert->cidr({subnet => "248.0.0.0"}), "5", "Verifying that Convert->cidr properly returned '5' when given a 'subnet' parameter of '248.0.0.0'.");
is($an->Convert->cidr({subnet => "252.0.0.0"}), "6", "Verifying that Convert->cidr properly returned '6' when given a 'subnet' parameter of '252.0.0.0'.");
is($an->Convert->cidr({subnet => "254.0.0.0"}), "7", "Verifying that Convert->cidr properly returned '7' when given a 'subnet' parameter of '254.0.0.0'.");
is($an->Convert->cidr({subnet => "255.0.0.0"}), "8", "Verifying that Convert->cidr properly returned '8' when given a 'subnet' parameter of '255.0.0.0'.");
is($an->Convert->cidr({subnet => "255.128.0.0"}), "9", "Verifying that Convert->cidr properly returned '9' when given a 'subnet' parameter of '255.128.0.0'.");
is($an->Convert->cidr({subnet => "255.192.0.0"}), "10", "Verifying that Convert->cidr properly returned '10' when given a 'subnet' parameter of '255.192.0.0'.");
is($an->Convert->cidr({subnet => "255.224.0.0"}), "11", "Verifying that Convert->cidr properly returned '11' when given a 'subnet' parameter of '255.224.0.0'.");
is($an->Convert->cidr({subnet => "255.240.0.0"}), "12", "Verifying that Convert->cidr properly returned '12' when given a 'subnet' parameter of '255.240.0.0'.");
is($an->Convert->cidr({subnet => "255.248.0.0"}), "13", "Verifying that Convert->cidr properly returned '13' when given a 'subnet' parameter of '255.248.0.0'.");
is($an->Convert->cidr({subnet => "255.252.0.0"}), "14", "Verifying that Convert->cidr properly returned '14' when given a 'subnet' parameter of '255.252.0.0'.");
is($an->Convert->cidr({subnet => "255.254.0.0"}), "15", "Verifying that Convert->cidr properly returned '15' when given a 'subnet' parameter of '255.254.0.0'.");
is($an->Convert->cidr({subnet => "255.255.0.0"}), "16", "Verifying that Convert->cidr properly returned '16' when given a 'subnet' parameter of '255.255.0.0'.");
is($an->Convert->cidr({subnet => "255.255.128.0"}), "17", "Verifying that Convert->cidr properly returned '17' when given a 'subnet' parameter of '255.255.128.0'.");
is($an->Convert->cidr({subnet => "255.255.192.0"}), "18", "Verifying that Convert->cidr properly returned '18' when given a 'subnet' parameter of '255.255.192.0'.");
is($an->Convert->cidr({subnet => "255.255.224.0"}), "19", "Verifying that Convert->cidr properly returned '19' when given a 'subnet' parameter of '255.255.224.0'.");
is($an->Convert->cidr({subnet => "255.255.240.0"}), "20", "Verifying that Convert->cidr properly returned '20' when given a 'subnet' parameter of '255.255.240.0'.");
is($an->Convert->cidr({subnet => "255.255.248.0"}), "21", "Verifying that Convert->cidr properly returned '21' when given a 'subnet' parameter of '255.255.248.0'.");
is($an->Convert->cidr({subnet => "255.255.252.0"}), "22", "Verifying that Convert->cidr properly returned '22' when given a 'subnet' parameter of '255.255.252.0'.");
is($an->Convert->cidr({subnet => "255.255.254.0"}), "23", "Verifying that Convert->cidr properly returned '23' when given a 'subnet' parameter of '255.255.254.0'.");
is($an->Convert->cidr({subnet => "255.255.255.0"}), "24", "Verifying that Convert->cidr properly returned '24' when given a 'subnet' parameter of '255.255.255.0'.");
is($an->Convert->cidr({subnet => "255.255.255.128"}), "25", "Verifying that Convert->cidr properly returned '25' when given a 'subnet' parameter of '255.255.255.128'.");
is($an->Convert->cidr({subnet => "255.255.255.192"}), "26", "Verifying that Convert->cidr properly returned '26' when given a 'subnet' parameter of '255.255.255.192'.");
is($an->Convert->cidr({subnet => "255.255.255.224"}), "27", "Verifying that Convert->cidr properly returned '27' when given a 'subnet' parameter of '255.255.255.224'.");
is($an->Convert->cidr({subnet => "255.255.255.240"}), "28", "Verifying that Convert->cidr properly returned '28' when given a 'subnet' parameter of '255.255.255.240'.");
is($an->Convert->cidr({subnet => "255.255.255.248"}), "29", "Verifying that Convert->cidr properly returned '29' when given a 'subnet' parameter of '255.255.255.248'.");
is($an->Convert->cidr({subnet => "255.255.255.252"}), "30", "Verifying that Convert->cidr properly returned '30' when given a 'subnet' parameter of '255.255.255.252'.");
is($an->Convert->cidr({subnet => "255.255.255.254"}), "31", "Verifying that Convert->cidr properly returned '31' when given a 'subnet' parameter of '255.255.255.254'.");
is($an->Convert->cidr({subnet => "255.255.255.255"}), "32", "Verifying that Convert->cidr properly returned '32' when given a 'subnet' parameter of '255.255.255.255'.");
### AN::Tools::Database tests
# <none yet>
### AN::Tools::Get tests
# date_and_time
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.");
# host_uuid
like($an->Get->host_uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to read host uuid.");
### TODO: How to test Get->switches?
# uuid
like($an->Get->uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to generate a random uuid.");
### AN::Tools::Log tests
# entry is tested at the start of this test suite.
# language
is($an->Log->language, "en_CA", "Verifying the default log language is 'en_CA'.");
$an->Log->language({set => "jp"});
is($an->Log->language, "jp", "Verifying the log language was changed to 'jp'.");
$an->Log->language({set => "en_CA"});
is($an->Log->language, "en_CA", "Verifying the log language is back to 'en_CA'.");
# log_level
is($an->Log->level, "1", "Verifying the default log level is '1'.");
$an->Log->level({set => 0});
is($an->Log->level, "0", "Verifying the log level changed to '0'.");
$an->Log->level({set => 1});
is($an->Log->level, "1", "Verifying the log level changed to '1'.");
$an->Log->level({set => 2});
is($an->Log->level, "2", "Verifying the log level changed to '2'.");
$an->Log->level({set => 3});
is($an->Log->level, "3", "Verifying the log level changed to '3'.");
$an->Log->level({set => 4});
is($an->Log->level, "4", "Verifying the log level changed to '4'.");
$an->Log->level({set => "foo"});
is($an->Log->level, "4", "Verifying the log level stayed at '4' with bad input.");
$an->Log->level({set => 1});
is($an->Log->level, "1", "Verifying the log level changed back to '1'.");
# secure
is($an->Log->secure, "0", "Verifying that logging secure messages is disabled by default.");
$an->Log->secure({set => "foo"});
is($an->Log->secure, "0", "Verifying that logging secure messages stayed disabled on bad input.");
$an->Log->secure({set => 1});
is($an->Log->secure, "1", "Verifying that logging secure messages was enabled.");
$an->Log->secure({set => 0});
is($an->Log->secure, "0", "Verifying that logging secure messages was disabled again.");
# variables
$an->Log->variables({level => 0, list => { a => "1" }});
my $list_a = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_a, "a: [1]", "Verified that we could log a list of variables (1 entry).");
$an->Log->variables({level => 0, list => { a => "1", b => "2" }});
my $list_b = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_b, "a: [1], b: [2]", "Verified that we could log a list of variables (2 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3" }});
my $list_c = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_c, "a: [1], b: [2], c: [3]", "Verified that we could log a list of variables (3 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4" }});
my $list_d = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_d, "a: [1], b: [2], c: [3], d: [4]", "Verified that we could log a list of variables (4 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4", e => "5" }});
my $list_e = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
my $say_variables = $an->Words->key({key => "log_0019"});
my $expect_e = "$say_variables
|- a: [1]
|- b: [2]
|- c: [3]
|- d: [4]
\\- e: [5]";
is($list_e, $expect_e, "Verified that we could log a list of variables (5 entries, line wrapping).");
# _adjust_log_level - We're simulating switches to test Log->_adjust_log_level
$an->data->{switches}{V} = "#!set!#";
$an->data->{switches}{v} = "";
$an->data->{switches}{vv} = "";
$an->data->{switches}{vvv} = "";
$an->data->{switches}{vvvv} = "";
$an->Log->_adjust_log_level;
is($an->Log->level, "0", "Verifying the log level was set to '0' with Log->_adjust_log_leve() with 'V' switch set.");
$an->data->{switches}{V} = "";
$an->data->{switches}{v} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "1", "Verifying the log level was set to '1' with Log->_adjust_log_leve() with 'v' switch set.");
$an->data->{switches}{v} = "";
$an->data->{switches}{vv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "2", "Verifying the log level was set to '2' with Log->_adjust_log_leve() with 'vv' switch set.");
$an->data->{switches}{vv} = "";
$an->data->{switches}{vvv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "3", "Verifying the log level was set to '3' with Log->_adjust_log_leve() with 'vvv' switch set.");
$an->data->{switches}{vvv} = "";
$an->data->{switches}{vvvv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "4", "Verifying the log level was set to '4' with Log->_adjust_log_leve() with 'vvvv' switch set.");
$an->data->{switches}{vvvv} = "";
$an->data->{switches}{v} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "1", "Verifying the log level was set back to '1' with Log->_adjust_log_leve() with 'v' switch set.");
### AN::Tools::Storage tests - These happen a little out of order.
# We need to pick a user name and group name to use for these tests. So we'll start by reading in passwd.
my $passwd = $an->Storage->read_file({file => "/etc/passwd"});
my $group = $an->Storage->read_file({file => "/etc/group"});
my $read_ok = 0;
my $use_user = "";
my $use_group = "";
foreach my $line (split/\n/, $passwd)
{
if ($line =~ /^root:/)
{
$read_ok = 1;
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_user = $1;
last;
}
}
foreach my $line (split/\n/, $group)
{
if ($line =~ /^root:/)
{
# skip
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_group = $1;
last;
}
}
# print "[ Debug ] - Using the user: [$use_user] and the group: [$use_group] for testing.\n";
is($read_ok, "1", "Verified that 'Storage->read_file' could read a file.");
# Write a file /tmp/foo
my $body = "This is a test file created as part of the AN::Tools test suite.\nYou can safely delete it if you wish.\n";
my $test_file = "/tmp/an-tools.test";
if (-e $test_file)
{
# remove the old test file.
unlink $test_file or die "The test file: [$test_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$an->Storage->write_file({body => $body, file => $test_file, group => $use_group, user => $use_user, mode => "0666"});
my $write_ok = 0;
if (-e $test_file)
{
$write_ok = 1;
}
is($write_ok, "1", "Verifying that 'Storage->write_file' could write a file (tested writing to: [$test_file]).");
my $mode = $an->Storage->read_mode({target => $test_file});
my ($uid, $gid) = (stat($test_file))[4,5];
my $file_user_name = getpwuid($uid);
my $file_group_name = getgrgid($gid);
#print "[ Debug ] - test_file: [$test_file], mode: [$mode], owning user: [$file_user_name ($uid)], owning group: [$file_group_name ($gid)]\n";
is($mode, "0666", "Verifying that 'Storage->write_file' set the mode correctly when writing a file.");
is($file_user_name, $use_user, "Verifying that 'Storage->write_file' set the user name properly when the file was written.");
is($file_group_name, $use_group, "Verifying that 'Storage->write_file' set the group name properly when the file was written.");
# change_mode
$an->Storage->change_mode({target => $test_file, mode => "4755"});
$mode = $an->Storage->read_mode({target => $test_file});
is($mode, "4755", "Verifying that 'Storage->change_mode' was able to change the mode of the test file (including setting the setuid and setgid sticky bits).");
$an->Storage->change_mode({target => $test_file, mode => "644"});
$mode = $an->Storage->read_mode({target => $test_file});
is($mode, "0644", "Verifying that 'Storage->change_mode' was able to change the mode of the test file using three digits instead of four.");
# change_owner
$an->Storage->change_owner({target => $test_file, user => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed only a user ID, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$an->Storage->change_owner({target => $test_file, user => $use_user});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a user name, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$an->Storage->change_owner({target => $test_file, group => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group ID, did not change the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed only a group ID, changed the group.");
$an->Storage->change_owner({target => $test_file, group => $use_group});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group name, did not change the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a group name, changed the group.");
$an->Storage->change_owner({target => $test_file, user => "root", group => "root"});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the group.");
my $change_owner_rc = $an->Storage->change_owner({target => "", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed no target, returned '1'.");
$change_owner_rc = "";
$change_owner_rc = $an->Storage->change_owner({target => "/fake/file", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed a bad file, returned '1'.");
# copy_file
my $copy_file = "/tmp/an-tools.copy";
my $copied_ok = 0;
if (-e $copy_file)
{
unlink $copy_file or die "The test copy file: [$copy_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$an->Storage->copy_file({source => $test_file, target => $copy_file});
if (-e $copy_file)
{
$copied_ok = 1;
}
is($copied_ok, "1", "Verifying that 'Storage->copy_file' was able to copy the test file.");
my $copy_rc = $an->Storage->copy_file({target => $copy_file});
is($copy_rc, "1", "Verifying that 'Storage->copy_file' returned '1' when no source file was passed.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file});
is($copy_rc, "2", "Verifying that 'Storage->copy_file' returned '2' when no target file was passed.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file, target => $copy_file});
is($copy_rc, "3", "Verifying that 'Storage->copy_file' returned '3' when the target file already exists.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file, target => $copy_file, overwrite => 1});
is($copy_rc, "0", "Verifying that 'Storage->copy_file' returned '0' when the target file already exists and overwrite was set.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => "/fake/file", target => $copy_file});
is($copy_rc, "4", "Verifying that 'Storage->copy_file' returned '4' when the target file is passed but doesn't exist.");
# find
my $test_path = $an->Storage->find({ file => "AN/Tools.t" });
is($test_path, "/usr/share/perl5/AN/Tools.t", "Verifying that Storage->find successfully found 'AN/Tools.t'.");
my $bad_path = $an->Storage->find({ file => "AN/wa.t" });
is($bad_path, "#!not_found!#", "Verifying that Storage->find properly returned '#!not_found!#' for a non-existed file.");
# make_directory
my $test_directory = "/tmp/an-tools/test/directory";
if (-d $test_directory)
{
foreach my $this_directory ("/tmp/an-tools/test/directory", "/tmp/an-tools/test", "/tmp/an-tools")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
}
# This uses an odd mode on purpose
$an->Storage->make_directory({directory => $test_directory, group => $use_group, user => $use_user, mode => "0757"});
my $created_directory = 0;
if (-d $test_directory)
{
$created_directory = 1;
}
is($created_directory, "1", "Verifying that 'Storage->create_directory' created a directory and its parents.");
my $directory_mode = $an->Storage->read_mode({target => $test_directory});
($uid, $gid) = (stat($test_directory))[4,5];
my $directory_user_name = getpwuid($uid);
my $directory_group_name = getgrgid($gid);
is($directory_mode, "0757", "Verifying that 'Storage->create_directory' created a directory with the requested mode.");
is($directory_user_name, $use_user, "Verifying that 'Storage->create_directory' created a directory with the requested owner.");
is($directory_group_name, $use_group, "Verifying that 'Storage->create_directory' created a directory with the requested group.");
# read_config
$an->data->{foo}{bar}{a} = "test";
is($an->Storage->read_config({ file => "AN/test.conf" }), 0, "Verifying that 'Storage->read_config' successfully found 'AN/test.conf'.");
is($an->Storage->read_config({ file => "" }), 1, "Verifying that 'Storage->read_config' returns '1' when called without a 'file' parameter being set.");
is($an->Storage->read_config({ file => "AN/moo.conf" }), 2, "Verifying that 'Storage->read_config' returns '2' when the non-existent 'AN/moo.conf' is passed.");
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.");
# read_file was tested earlier.
# read_mode was tested earlier.
# search_directories
my $array1 = $an->Storage->search_directories;
my $a1_count = @{$array1};
cmp_ok($a1_count, '>', 0, "Verifying that Storage->search_directories has at least one entry. Found: [$a1_count] directories.");
$an->Storage->search_directories({directories => "/root,/usr/bin,/some/fake/directory"});
my $array2 = $an->Storage->search_directories;
my $a2_count = @{$array2};
cmp_ok($a2_count, '==', 2, "Verifying that Storage->search_directories now has 2 entries from a passed in CSV, testing that the list changed and a fake directory was dropped.");
$an->Storage->search_directories({directories => ["/usr/bin", "/tmp", "/home"] });
my $array3 = $an->Storage->search_directories;
my $a3_count = @{$array3};
cmp_ok($a3_count, '==', 3, "Verifying that Storage->search_directories now has 3 entries from a passed in array reference, verifying that the list changed again.");
$an->Storage->search_directories({directories => "invalid" });
my $array4 = $an->Storage->search_directories;
my $a4_count = @{$array4};
cmp_ok($a4_count, '==', $a1_count, "Verifying that Storage->search_directories has the original number of directories: [$a4_count] after being called with an invalid 'directories' parameter, showing that it reset properly.");
# write_file was tested earlier
# Cleanup.
unlink $test_file;
unlink $copy_file;
foreach my $this_directory ("/tmp/an-tools/test/directory", "/tmp/an-tools/test", "/tmp/an-tools")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
### AN::Tools::System tests
# call was tested during the Log->entry test and will be tested further below.
# Daemon tests require that we create a test daemon and a unit for it...
my $test_daemon_file = "/tmp/an-tools-test.daemon";
my $test_daemon_body = q|#!/usr/bin/perl
# This is a test daemon created for the AN::Tools test suite. It can safely be deleted.
use strict;
use warnings;
use AN::Tools;
my $an = AN::Tools->new();
$an->Log->entry({level => 1, priority => "info", raw => "AN::Tools Test daemon started."});
while(1)
{
sleep 2;
$an->Log->entry({level => 1, priority => "info", raw => "AN::Tools Test daemon looped..."});
}
exit;
|;
$an->Storage->write_file({body => $test_daemon_body, file => $test_daemon_file, group => "root", user => "root", mode => "755", overwrite => 1});
my $test_service_name = "an-tools-test.service";
my $test_service_file = "/usr/lib/systemd/system/".$test_service_name;
my $test_service_body = "[Unit]
Description=Test daemon used by AN::Tools test suite. It can safely be ignored/deleted.
[Service]
Type=simple
ExecStart=$test_daemon_file
ExecStop=/bin/kill -WINCH \${MAINPID}
";
$an->Storage->write_file({body => $test_service_body, file => $test_service_file, group => "root", user => "root", mode => "644", overwrite => 1});
$an->System->call({shell_call => $an->data->{path}{exe}{systemctl}." daemon-reload"});
$an->System->stop_daemon({daemon => $test_service_name}); # Just in case...
# check_daemon
my $test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->start_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->start_daemon' was able to start the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "1", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] is now running.");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->stop_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->stop_daemon' was able to stop the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
# Cleanup
unlink $test_service_file;
unlink $test_daemon_file;
$an->System->call({shell_call => $an->data->{path}{exe}{systemctl}." daemon-reload"});
### AN::Tools::Template tests
# We're going to need a fake template file to test.
my $test_template_file = "/tmp/an-tools.html";
my $test_template_body = '<!-- start test1 -->
This is test template #1.
<!-- end test1 -->
<!-- start test2 -->
This is test template #2. It has a replacement: [#!variable!test!#].
<!-- end test2 -->
';
$an->Storage->write_file({body => $test_template_body, file => $test_template_file, mode => "644", overwrite => 1});
# get
my $test1_template = $an->Template->get({file => $test_template_file, name => "test1"});
is($test1_template, "This is test template #1.\n", "Verifying that 'Template->get' was able to read a test template.");
my $test2_template = $an->Template->get({file => $test_template_file, name => "test2", variables => { test => "boo!" }});
is($test2_template, "This is test template #2. It has a replacement: [boo!].\n", "Verifying that 'Template->get' was able to read a test template with a variable insertion.");
is($an->Template->skin, "alteeve", "Verifying that 'Template->skin' is initially set to 'alteeve'.");
$an->Template->skin({fatal => 0, set => "test"}); # We disable fatal because there may be no skin directory yet.
is($an->Template->skin, "test", "Verifying that 'Template->skin' was changed to 'test'.");
$an->Template->skin({fatal => 0, set => "alteeve"});
is($an->Template->skin, "alteeve", "Verifying that 'Template->skin' was changed back to 'alteeve'.");
# Clean up
unlink $test_template_file;
### AN::Tools::Validate tests
# is_ipv4
is($an->Validate->is_ipv4({ip => "0.0.0.0"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '0.0.0.0' as a valid IP address.");
is($an->Validate->is_ipv4({ip => "255.255.255.255"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '255.255.255.255' as a valid IP address.");
is($an->Validate->is_ipv4({ip => "256.255.255.255"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '256.255.255.255' as an invalid IP address.");
is($an->Validate->is_ipv4({ip => "alteeve.com"}), "0", "Verifying that 'Validate->is_ipv4' recognizes 'alteeve.com' as an invalid IP address.");
is($an->Validate->is_ipv4({ip => "::1"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '::1' as an invalid IP address.");
my $test_uuid = $an->Get->uuid;
is($an->Validate->is_uuid({uuid => $test_uuid}), "1", "Verifying that 'Validate->is_uuid' recognized: [".$test_uuid."] as a valid UUID.");
my $bad_uuid_1 = $test_uuid;
$bad_uuid_1 =~ s/-//g;
is($an->Validate->is_uuid({uuid => $bad_uuid_1}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_1."] as an invalid UUID.");
my $bad_uuid_2 = uc($test_uuid);
is($an->Validate->is_uuid({uuid => $bad_uuid_2}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_2."] as an invalid UUID.");
my $bad_uuid_3 = $test_uuid."toolong";
is($an->Validate->is_uuid({uuid => $bad_uuid_3}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_3."] as an invalid UUID.");
### AN::Tools::Words tests
# clean_spaces
my $clean_string1 = " A line with spaces all over ";
my $clean_string2 = "A line with spaces at the end only ";
my $clean_string3 = " A line with spaces in the front only";
my $clean_string4 = "A line with spaces in the middle only";
is($an->Words->clean_spaces({string => $clean_string1}), "A line with spaces all over", "Verifying that 'Words->clean_spaces' cleaned up a string with random spaces.");
is($an->Words->clean_spaces({string => $clean_string2}), "A line with spaces at the end only", "Verifying that 'Words->clean_spaces' cleaned up a string spaces at the end of a string.");
is($an->Words->clean_spaces({string => $clean_string3}), "A line with spaces in the front only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the front only.");
is($an->Words->clean_spaces({string => $clean_string4}), "A line with spaces in the middle only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the middle only.");
# key
is($an->Words->key({key => "t_0001"}), "Test replace: [#!variable!test!#].", "Verifying that 'Words->key' returned the Canadian English 't_0001' string.");
is($an->Words->key({key => "t_0001", language => "jp"}), "ใƒ†ใ‚นใƒˆ ใ„ใ‚Œใ‹ใˆใ‚‹: [#!variable!test!#]ใ€‚", "Verifying that 'Words->read' returned the Japanese 't_0001' string.");
is($an->Words->key({key => "bad_key"}), "#!not_found!#", "Verified that 'Words->key' returns '#!not_found!#' for a bad key.");
is($an->Words->key({key => "t_0003", language => "jp"}), "#!not_found!#", "Verifying that 'Words->read' returned '#!not_found!#' for the missing 't_0003' key.");
# language
is($an->Words->language, "en_CA", "Verifying the default words language is 'en_CA'.");
$an->Words->language({set => "jp"});
is($an->Words->language, "jp", "Verifying the words language was changed to 'jp'.");
$an->Words->language({set => "en_CA"});
is($an->Words->language, "en_CA", "Verifying the words language is back to 'en_CA'.");
# read
### NOTE: At this time, we don't test for unreadable files (rc = 3) or general read faults as set by XML::Simple (rc = 4).
is($an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}), 0, "Verifying that 'Words->read' properly returned '0' when asked to read the AN::Tools's words file.");
is($an->Words->read({file => ''}), 1, "Verifying that 'Words->read' properly returned '1' when asked to read a works file without a file being passed.");
is($an->Words->read({file => '/tmp/dummy.xml'}), 2, "Verifying that 'Words->read' properly returned '2' when asked to read a non-existent file.");
# string
my $test_string1 = $an->Words->string({
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string1, "
This is a multi-line test string with various items to insert.
It also has some #!invalid!# replacement #!keys!# to test the escaping and restoring.
Here is the default output language: [en_CA]
Here we will inject 't_0000': [Test replace: [result!].]
Here we will inject 't_0002' with its embedded variables: [Test Out of order: [2nd] replace: [1st].]
Here we will inject 't_0006', which injects 't_0001' which has a variable: [This string embeds 't_0001': [Test replace: [result!].]].
", "Verifying string processing in the default (Canadian English) language.");
my $test_string2 = $an->Words->string({
language => "jp",
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string2, "
ใ“ใ‚Œใฏใ€ๆŒฟๅ…ฅใ™ใ‚‹ใ•ใพใ–ใพใช้ …็›ฎใ‚’ๅซใ‚€่ค‡ๆ•ฐ่กŒใฎใƒ†ใ‚นใƒˆๆ–‡ๅญ—ๅˆ—ใงใ™ใ€‚
#!็„กๅŠน#!ใช็ฝฎๆ›!#ใ‚ญใƒผ!#ใ‚’ไฝฟใฃใฆใ‚จใ‚นใ‚ฑใƒผใƒ—ใจใƒชใ‚นใƒˆใ‚ขใ‚’ใƒ†ใ‚นใƒˆใ™ใ‚‹ใ“ใจใ‚‚ใงใใพใ™ใ€‚
ใƒ‡ใƒ•ใ‚ฉใƒซใƒˆใฎๅ‡บๅŠ›่จ€่ชžใฏๆฌกใฎใจใŠใ‚Šใงใ™๏ผšใ€Œen_CAใ€
ใ“ใ“ใงใ€ใ€Œt_0000ใ€ใ‚’ๆŒฟๅ…ฅใ—ใพใ™๏ผš[ใƒ†ใ‚นใƒˆ ใ„ใ‚Œใ‹ใˆใ‚‹: [result!]ใ€‚]
ใ“ใ“ใงใฏใ€ ใ€Œt_0002ใ€ใซๅŸ‹ใ‚่พผใฟๅค‰ๆ•ฐใ‚’ๆŒฟๅ…ฅใ—ใพใ™๏ผšใ€Œใƒ†ใ‚นใƒˆใ€ ๆ•ด็†: [2nd]/[1st]ใ€‚ใ€
ใ“ใ“ใงใฏๅค‰ๆ•ฐ ใ€Œใ“ใฎๆ–‡ๅญ—ๅˆ—ใซใฏใ€Œt_0001ใ€ใŒๅŸ‹ใ‚่พผใพใ‚Œใฆใ„ใพใ™๏ผšใ€Œใƒ†ใ‚นใƒˆ ใ„ใ‚Œใ‹ใˆใ‚‹: [result!]ใ€‚ใ€ใ€ใ‚’ๆŒใค ใ€Œt_0001ใ€ใ‚’ๆณจๅ…ฅใ™ใ‚‹ ใ€Œt_0006ใ€ใ‚’ๆณจๅ…ฅใ—ใพใ™ใ€‚
", "Verifying string processing in Japanese.");
### DONE!
# Tell the user that we're done making noise in their logs
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0049"});

@ -1,4 +1,4 @@
package AN::Tools;
package Anvil::Tools;
#
# This is the "root" package that manages the sub modules and controls access to their methods.
#
@ -35,17 +35,17 @@ 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::Database;
use AN::Tools::Convert;
use AN::Tools::Get;
use AN::Tools::Log;
use AN::Tools::Storage;
use AN::Tools::System;
use AN::Tools::Template;
use AN::Tools::Words;
use AN::Tools::Validate;
# methods via their containing module's name. (A La: C<< $anvil->Module->method >> rather than C<< $anvil->method >>).
use Anvil::Tools::Alert;
use Anvil::Tools::Database;
use Anvil::Tools::Convert;
use Anvil::Tools::Get;
use Anvil::Tools::Log;
use Anvil::Tools::Storage;
use Anvil::Tools::System;
use Anvil::Tools::Template;
use Anvil::Tools::Words;
use Anvil::Tools::Validate;
=pod
@ -53,19 +53,19 @@ use AN::Tools::Validate;
=head1 NAME
AN::Tools
Anvil::Tools
Provides a common oject handle to all AN::Tools::* module methods and handles invocation configuration.
Provides a common oject handle to all Anvil::Tools::* module methods and handles invocation configuration.
=head1 SYNOPSIS
use AN::Tools;
use Anvil::Tools;
# Get a common object handle on all AN::Tools::* modules.
my $an = AN::Tools->new();
# Get a common object handle on all Anvil::Tools::* modules.
my $anvil = Anvil::Tools->new();
# Again, but this time sets some initial values in the '$an->data' hash.
my $an = AN::Tools->new(
# Again, but this time sets some initial values in the '$anvil->data' hash.
my $anvil = Anvil::Tools->new(
{
data => {
foo => "",
@ -77,7 +77,7 @@ Provides a common oject handle to all AN::Tools::* module methods and handles in
# 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(
my $anvil = Anvil::Tools->new(
{
'Log' => {
user_language => "jp",
@ -88,7 +88,7 @@ Provides a common oject handle to all AN::Tools::* module methods and handles in
=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.
The Anvil::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;
@ -110,16 +110,16 @@ sub new
my $parameter = shift;
my $self = {
HANDLE => {
ALERT => AN::Tools::Alert->new(),
DATABASE => AN::Tools::Database->new(),
CONVERT => AN::Tools::Convert->new(),
GET => AN::Tools::Get->new(),
LOG => AN::Tools::Log->new(),
STORAGE => AN::Tools::Storage->new(),
SYSTEM => AN::Tools::System->new(),
TEMPLATE => AN::Tools::Template->new(),
WORDS => AN::Tools::Words->new(),
VALIDATE => AN::Tools::Validate->new(),
ALERT => Anvil::Tools::Alert->new(),
DATABASE => Anvil::Tools::Database->new(),
CONVERT => Anvil::Tools::Convert->new(),
GET => Anvil::Tools::Get->new(),
LOG => Anvil::Tools::Log->new(),
STORAGE => Anvil::Tools::Storage->new(),
SYSTEM => Anvil::Tools::System->new(),
TEMPLATE => Anvil::Tools::Template->new(),
WORDS => Anvil::Tools::Words->new(),
VALIDATE => Anvil::Tools::Validate->new(),
},
DATA => {},
ENV_VALUES => {
@ -135,62 +135,62 @@ sub new
bless $self, $class;
# This isn't needed, but it makes the code below more consistent with and portable to other modules.
my $an = $self;
weaken($an); # Helps avoid memory leaks. See Scalar::Utils
my $anvil = $self;
weaken($anvil); # Helps avoid memory leaks. See Scalar::Utils
# Record the start time.
$an->data->{ENV_VALUES}{START_TIME} = Time::HiRes::time;
$anvil->data->{ENV_VALUES}{START_TIME} = Time::HiRes::time;
# Get a handle on the various submodules
$an->Alert->parent($an);
$an->Database->parent($an);
$an->Convert->parent($an);
$an->Get->parent($an);
$an->Log->parent($an);
$an->Storage->parent($an);
$an->System->parent($an);
$an->Template->parent($an);
$an->Words->parent($an);
$an->Validate->parent($an);
$anvil->Alert->parent($anvil);
$anvil->Database->parent($anvil);
$anvil->Convert->parent($anvil);
$anvil->Get->parent($anvil);
$anvil->Log->parent($anvil);
$anvil->Storage->parent($anvil);
$anvil->System->parent($anvil);
$anvil->Template->parent($anvil);
$anvil->Words->parent($anvil);
$anvil->Validate->parent($anvil);
# Set some system paths and system default variables
$an->_set_paths;
$an->_set_defaults;
$anvil->_set_paths;
$anvil->_set_defaults;
# This will help clean up if we catch a signal.
$SIG{INT} = sub { $an->catch_sig({signal => "INT"}); };
$SIG{TERM} = sub { $an->catch_sig({signal => "TERM"}); };
$SIG{INT} = sub { $anvil->catch_sig({signal => "INT"}); };
$SIG{TERM} = sub { $anvil->catch_sig({signal => "TERM"}); };
# This sets the environment this program is running in.
if ($ENV{SERVER_NAME})
{
$an->environment("html");
$anvil->environment("html");
# There is no PWD environment variable, so we'll use 'DOCUMENT_ROOT' as 'PWD'
$ENV{PWD} = $ENV{DOCUMENT_ROOT};
}
else
{
$an->environment("cli");
$anvil->environment("cli");
}
# 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};
# Setup my '$anvil->data' hash right away so that I have a place to store the strings hash.
$anvil->data($parameter->{data}) if $parameter->{data};
# Initialize the list of directories to seach.
$an->Storage->search_directories({initialize => 1});
$anvil->Storage->search_directories({initialize => 1});
# I need to read the initial words early.
$an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}});
$anvil->Words->read({file => $anvil->data->{path}{words}{'words.xml'}});
# If the local './tools.conf' file exists, read it in.
if (-r "./tools.conf")
if (-r $anvil->data->{path}{configs}{'anvil.conf'})
{
$an->Storage->read_config({file => "./tools.conf"});
$anvil->Storage->read_config({file => $anvil->data->{path}{configs}{'anvil.conf'}});
}
# Read in any command line switches.
$an->Get->switches;
$anvil->Get->switches;
# Set passed parameters if needed.
if (ref($parameter) eq "HASH")
@ -201,7 +201,7 @@ sub new
elsif($parameter)
{
# Um...
print $THIS_FILE." ".__LINE__."; AN::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n";
print $THIS_FILE." ".__LINE__."; Anvil::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n";
exit(1);
}
@ -217,18 +217,18 @@ sub new
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.
When called without an argument, it returns the existing '$anvil->data' hash reference.
my $an = $an->data();
my $anvil = $anvil->data();
When called with a hash reference as the argument, it sets '$an->data' to the new hash.
When called with a hash reference as the argument, it sets '$anvil->data' to the new hash.
my $some_hash = {};
my $an = $an->data($some_hash);
my $anvil = $anvil->data($some_hash);
Data can be entered into or access by treating '$an->data' as a normal hash reference.
Data can be entered into or access by treating '$anvil->data' as a normal hash reference.
my $an = AN::Tools->new(
my $anvil = Anvil::Tools->new(
{
data => {
foo => "",
@ -241,22 +241,22 @@ Data can be entered into or access by treating '$an->data' as a normal hash refe
});
# Copy the 'Cat' value into the $animal variable.
my $animal = $an->data->{baz}{animal};
my $animal = $anvil->data->{baz}{animal};
# Set 'A thing' in 'foo'.
$an->data->{foo} = "A thing";
$anvil->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.
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 Anvil::Tools.
=cut
sub data
{
my ($an) = shift;
my ($anvil) = shift;
# Pick up the passed in hash, if any.
$an->{DATA} = shift if $_[0];
$anvil->{DATA} = shift if $_[0];
return ($an->{DATA});
return ($anvil->{DATA});
}
=head2 environment
@ -265,32 +265,32 @@ This is the method used to check or set whether the program is outputting to com
When called without an argument, it returns the current environment.
if ($an->environment() eq "cli")
if ($anvil->environment() eq "cli")
{
# format for STDOUT
}
elsif ($an->environment() eq "html")
elsif ($anvil->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");
$anvil->environment("cli");
Technically, any string can be used, however only 'cli' or 'html' are used by convention.
=cut
sub environment
{
my ($an) = shift;
weaken($an);
my ($anvil) = shift;
weaken($anvil);
# Pick up the passed in delimiter, if any.
if ($_[0])
{
$an->{ENV_VALUES}{ENVIRONMENT} = shift;
if ($an->{ENV_VALUES}{ENVIRONMENT} eq "html")
$anvil->{ENV_VALUES}{ENVIRONMENT} = shift;
if ($anvil->{ENV_VALUES}{ENVIRONMENT} eq "html")
{
# Load the CGI stuff if we're in a browser
use CGI;
@ -298,7 +298,7 @@ sub environment
}
}
return ($an->{ENV_VALUES}{ENVIRONMENT});
return ($anvil->{ENV_VALUES}{ENVIRONMENT});
}
=head2 nice_exit
@ -316,22 +316,22 @@ sub nice_exit
{
my $self = shift;
my $parameter = shift;
my $an = $self;
my $anvil = $self;
my $exit_code = defined $parameter->{exit_code} ? $parameter->{exit_code} : 0;
# Close database connections (if any).
$an->Database->disconnect();
$anvil->Database->disconnect();
# Report the runtime.
my $end_time = Time::HiRes::time;
my $run_time = $end_time - $an->data->{ENV_VALUES}{START_TIME};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
's1:ENV_VALUES::START_TIME' => $an->data->{ENV_VALUES}{START_TIME},
my $run_time = $end_time - $anvil->data->{ENV_VALUES}{START_TIME};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
's1:ENV_VALUES::START_TIME' => $anvil->data->{ENV_VALUES}{START_TIME},
's2:end_time' => $end_time,
's3:run_time' => $run_time,
}});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0135", variables => { runtime => $run_time }});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0135", variables => { runtime => $run_time }});
exit($exit_code);
}
@ -343,13 +343,13 @@ sub nice_exit
=head1 Submodule Access Methods
The methods below are used to access methods of submodules using 'C<< $an->Module->method() >>'.
The methods below are used to access methods of submodules using 'C<< $anvil->Module->method() >>'.
=cut
=head2 Alert
Access the C<Alert.pm> methods via 'C<< $an->Alert->method >>'.
Access the C<Alert.pm> methods via 'C<< $anvil->Alert->method >>'.
=cut
sub Alert
@ -361,7 +361,7 @@ sub Alert
=head2 Database
Access the C<Database.pm> methods via 'C<< $an->Database->method >>'.
Access the C<Database.pm> methods via 'C<< $anvil->Database->method >>'.
=cut
sub Database
@ -373,7 +373,7 @@ sub Database
=head2 Convert
Access the C<Convert.pm> methods via 'C<< $an->Convert->method >>'.
Access the C<Convert.pm> methods via 'C<< $anvil->Convert->method >>'.
=cut
sub Convert
@ -385,7 +385,7 @@ sub Convert
=head2 Get
Access the C<Get.pm> methods via 'C<< $an->Get->method >>'.
Access the C<Get.pm> methods via 'C<< $anvil->Get->method >>'.
=cut
sub Get
@ -397,7 +397,7 @@ sub Get
=head2 Log
Access the C<Log.pm> methods via 'C<< $an->Log->method >>'.
Access the C<Log.pm> methods via 'C<< $anvil->Log->method >>'.
=cut
sub Log
@ -409,7 +409,7 @@ sub Log
=head2 Storage
Access the C<Storage.pm> methods via 'C<< $an->Storage->method >>'.
Access the C<Storage.pm> methods via 'C<< $anvil->Storage->method >>'.
=cut
sub Storage
@ -421,7 +421,7 @@ sub Storage
=head2 System
Access the C<System.pm> methods via 'C<< $an->System->method >>'.
Access the C<System.pm> methods via 'C<< $anvil->System->method >>'.
=cut
sub System
@ -433,7 +433,7 @@ sub System
=head2 Template
Access the C<Template.pm> methods via 'C<< $an->Template->method >>'.
Access the C<Template.pm> methods via 'C<< $anvil->Template->method >>'.
=cut
sub Template
@ -445,7 +445,7 @@ sub Template
=head2 Words
Access the C<Words.pm> methods via 'C<< $an->Words->method >>'.
Access the C<Words.pm> methods via 'C<< $anvil->Words->method >>'.
=cut
sub Words
@ -457,7 +457,7 @@ sub Words
=head2 Validate
Access the C<Validate.pm> methods via 'C<< $an->Validate->method >>'.
Access the C<Validate.pm> methods via 'C<< $anvil->Validate->method >>'.
=cut
sub Validate
@ -470,7 +470,7 @@ sub Validate
=head1 Private Functions;
These methods generally should never be called from a program using AN::Tools. However, we are not your boss.
These methods generally should never be called from a program using Anvil::Tools. However, we are not your boss.
=cut
@ -480,7 +480,7 @@ These methods generally should never be called from a program using AN::Tools. H
=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.
This is a helper to the '$anvil->_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.
@ -512,7 +512,7 @@ This returns the (full) hostname for the machine this is running on.
sub _hostname
{
my $self = shift;
my $an = $self;
my $anvil = $self;
my $hostname = "";
if ($ENV{HOSTNAME})
@ -523,7 +523,7 @@ sub _hostname
else
{
# The environment variable isn't set. Call 'hostname' on the command line.
$hostname = $an->System->call({shell_call => $an->data->{path}{exe}{hostname}});
$hostname = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{hostname}});
}
return($hostname);