* Added Scalar::Util->weaken to help avoid memory leaks.

* Added Tools->catch_sig to cleanly exit when SIGINT and SIGKILL.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 7 years ago
parent 215d96b983
commit b5e7054a33
  1. 43
      AN/Tools.pm
  2. 7
      AN/Tools/Alert.pm
  3. 8
      AN/Tools/Convert.pm
  4. 27
      AN/Tools/Database.pm
  5. 7
      AN/Tools/Get.pm
  6. 7
      AN/Tools/Log.pm
  7. 9
      AN/Tools/Storage.pm
  8. 7
      AN/Tools/System.pm
  9. 7
      AN/Tools/Template.pm
  10. 7
      AN/Tools/Validate.pm
  11. 7
      AN/Tools/Words.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;

@ -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});
}

@ -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});
}

@ -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__});

@ -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});
}

@ -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});
}

@ -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});

@ -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});
}

@ -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});
}

@ -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});
}

@ -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});
}

Loading…
Cancel
Save