diff --git a/AN/Tools.pm b/AN/Tools.pm index 4f1403bd..814f91cc 100755 --- a/AN/Tools.pm +++ b/AN/Tools.pm @@ -13,6 +13,7 @@ BEGIN use strict; use warnings; +use Scalar::Util qw(weaken isweak); use Data::Dumper; my $THIS_FILE = "Tools.pm"; @@ -128,12 +129,13 @@ sub new UUID => "", }, }; - + # Bless you! bless $self, $class; - + # This isn't needed, but it makes the code below more consistent with and portable to other modules. - my $an = $self; + my $an = $self; + weaken($an); # Helps avoid memory leaks. See Scalar::Utils # Get a handle on the various submodules $an->Alert->parent($an); @@ -146,11 +148,15 @@ sub new $an->Template->parent($an); $an->Words->parent($an); $an->Validate->parent($an); - + # Set some system paths and system default variables $an->_set_paths; $an->_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"}); }; + # This sets the environment this program is running in. if ($ENV{SERVER_NAME}) { @@ -163,13 +169,13 @@ sub new { $an->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}; # 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'}}); @@ -194,7 +200,7 @@ sub new print $THIS_FILE." ".__LINE__."; AN::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n"; exit(1); } - + return ($self); } @@ -273,7 +279,9 @@ Technically, any string can be used, however only 'cli' or 'html' are used by co =cut sub environment { - my ($an) = shift; + my ($an) = shift; + weaken($an); + # Pick up the passed in delimiter, if any. $an->{ENV_VALUES}{ENVIRONMENT} = shift if $_[0]; @@ -780,4 +788,21 @@ The following packages provide non-critical functionality. =cut + +# This catches SIGINT and SIGTERM and fires out an email before shutting down. +sub catch_sig +{ + my $self = shift; + my $parameter = shift; + my $an = $self; + my $signal = $parameter->{signal} ? $parameter->{signal} : ""; + + if ($signal) + { + print "Process with PID: [$$] exiting on SIG".$signal.".\n"; + } + $an->nice_exit({code => 255}); +} + + 1; diff --git a/AN/Tools/Alert.pm b/AN/Tools/Alert.pm index e5f365b1..c21aeff7 100755 --- a/AN/Tools/Alert.pm +++ b/AN/Tools/Alert.pm @@ -5,6 +5,7 @@ package AN::Tools::Alert; use strict; use warnings; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Alert.pm"; @@ -59,6 +60,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Convert.pm b/AN/Tools/Convert.pm index f35032a0..ca50de9d 100755 --- a/AN/Tools/Convert.pm +++ b/AN/Tools/Convert.pm @@ -5,7 +5,7 @@ package AN::Tools::Convert; use strict; use warnings; -use Data::Dumper; +use Scalar::Util qw(weaken isweak); use Math::BigInt; our $VERSION = "3.0.0"; @@ -66,6 +66,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Database.pm b/AN/Tools/Database.pm index 2f327b5c..93214a5a 100755 --- a/AN/Tools/Database.pm +++ b/AN/Tools/Database.pm @@ -6,6 +6,7 @@ package AN::Tools::Database; use strict; use warnings; use DBI; +use Scalar::Util qw(weaken isweak); use Data::Dumper; our $VERSION = "3.0.0"; @@ -80,6 +81,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } @@ -185,7 +192,7 @@ sub configure_pgsql my $self = shift; my $parameter = shift; my $an = $self->parent; - $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "log_0125", variables => { method => "Database->configure_pgsql()" }}); + $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0125", variables => { method => "Database->configure_pgsql()" }}); my $id = defined $parameter->{id} ? $parameter->{id} : ""; $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { id => $id }}); @@ -519,9 +526,7 @@ sub configure_pgsql task => "open", port_number => $an->data->{database}{$id}{port}, }); - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { port_status => $port_status }}); - - die $THIS_FILE." ".__LINE__."; testing...\n"; + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { port_status => $port_status }}); return(0); } @@ -605,7 +610,7 @@ sub connect my $self = shift; my $parameter = shift; my $an = $self->parent; - $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "log_0125", variables => { method => "Database->connect()" }}); + $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0125", variables => { method => "Database->connect()" }}); my $source = defined $parameter->{source} ? $parameter->{source} : "core"; my $sql_file = defined $parameter->{sql_file} ? $parameter->{sql_file} : $an->data->{path}{sql}{'Tools.sql'}; @@ -647,7 +652,7 @@ sub connect my $name = $an->data->{database}{$id}{name} ? $an->data->{database}{$id}{name} : ""; # This should fail my $user = $an->data->{database}{$id}{user} ? $an->data->{database}{$id}{user} : ""; # This should fail my $password = $an->data->{database}{$id}{password} ? $an->data->{database}{$id}{password} : ""; - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { host => $host, port => $port, name => $name, @@ -721,7 +726,7 @@ sub connect if ($is_local) { $an->data->{sys}{read_db_id} = $id; - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "sys::read_db_id" => $an->data->{sys}{read_db_id} }}); + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "sys::read_db_id" => $an->data->{sys}{read_db_id} }}); # Set it up (or update it) if needed. This method just returns if nothing is needed. $an->Database->configure_pgsql({id => $id}); @@ -731,7 +736,6 @@ sub connect $an->data->{sys}{read_db_id} = $id; $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "sys::read_db_id" => $an->data->{sys}{read_db_id} }}); } - next; # Connect! my $dbh = ""; @@ -883,10 +887,9 @@ sub connect }}); } } - die; # Do I have any connections? Don't die, if not, just return. - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { connections => $connections }}); + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { connections => $connections }}); if (not $connections) { # Failed to connect to any database. Log this, print to the caller and return. @@ -1015,7 +1018,6 @@ sub connect source => $source, tables => $tables, }); - die; # Hold if a lock has been requested. $an->Database->locking(); @@ -1269,12 +1271,11 @@ sub initialize $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }}); my $sql = $an->Storage->read_file({file => $sql_file}); - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { ">> sql" => $sql }}); + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { ">> sql" => $sql }}); $sql =~ s/#!variable!user!#/$user/sg; $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "<< sql" => $sql }}); - ### NOTE: Left off here # Now that I am ready, disable autocommit, write and commit. $an->Database->write({id => $id, query => $sql, source => $THIS_FILE, line => __LINE__}); diff --git a/AN/Tools/Get.pm b/AN/Tools/Get.pm index af40ccdc..3ee38bd1 100755 --- a/AN/Tools/Get.pm +++ b/AN/Tools/Get.pm @@ -5,6 +5,7 @@ package AN::Tools::Get; use strict; use warnings; +use Scalar::Util qw(weaken isweak); use Data::Dumper; our $VERSION = "3.0.0"; @@ -68,6 +69,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Log.pm b/AN/Tools/Log.pm index 0efff0af..45679382 100755 --- a/AN/Tools/Log.pm +++ b/AN/Tools/Log.pm @@ -6,6 +6,7 @@ package AN::Tools::Log; use strict; use warnings; use Data::Dumper; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Log.pm"; @@ -68,6 +69,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Storage.pm b/AN/Tools/Storage.pm index 8dbff186..5f4f5474 100755 --- a/AN/Tools/Storage.pm +++ b/AN/Tools/Storage.pm @@ -6,6 +6,7 @@ package AN::Tools::Storage; use strict; use warnings; use Data::Dumper; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Storage.pm"; @@ -70,6 +71,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } @@ -944,7 +951,7 @@ sub write_file if ($secure) { my $shell_call = $an->data->{path}{exe}{touch}." ".$file; - $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { shell_call => $shell_call }}); + $an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { shell_call => $shell_call }}); $an->System->call({shell_call => $shell_call}); $an->Storage->change_mode({target => $file, mode => $mode}); diff --git a/AN/Tools/System.pm b/AN/Tools/System.pm index e940ecb9..535353ce 100755 --- a/AN/Tools/System.pm +++ b/AN/Tools/System.pm @@ -7,6 +7,7 @@ use strict; use warnings; use Data::Dumper; use Net::SSH2; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "System.pm"; @@ -75,6 +76,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Template.pm b/AN/Tools/Template.pm index e10d8c6c..59ebafb8 100755 --- a/AN/Tools/Template.pm +++ b/AN/Tools/Template.pm @@ -6,6 +6,7 @@ package AN::Tools::Template; use strict; use warnings; use Data::Dumper; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Template.pm"; @@ -64,6 +65,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Validate.pm b/AN/Tools/Validate.pm index 3c593100..e6c931b8 100755 --- a/AN/Tools/Validate.pm +++ b/AN/Tools/Validate.pm @@ -6,6 +6,7 @@ package AN::Tools::Validate; use strict; use warnings; use Data::Dumper; +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Validate.pm"; @@ -63,6 +64,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); } diff --git a/AN/Tools/Words.pm b/AN/Tools/Words.pm index 37b97c4a..5d7a3891 100755 --- a/AN/Tools/Words.pm +++ b/AN/Tools/Words.pm @@ -7,6 +7,7 @@ use strict; use warnings; use Data::Dumper; use XML::Simple qw(:strict); +use Scalar::Util qw(weaken isweak); our $VERSION = "3.0.0"; my $THIS_FILE = "Words.pm"; @@ -72,6 +73,12 @@ sub parent $self->{HANDLE}{TOOLS} = $parent if $parent; + # Defend against memory leads. See Scalar::Util'. + if (not isweak($self->{HANDLE}{TOOLS})) + { + weaken($self->{HANDLE}{TOOLS});; + } + return ($self->{HANDLE}{TOOLS}); }