package AN::Tools::Alert; # # This module contains methods used to handle alerts and errors. # use strict; use warnings; our $VERSION = "3.0.0"; my $THIS_FILE = "Alert.pm"; ### Methods; # error =pod =encoding utf8 =head1 NAME AN::Tools::Alert Provides all methods related warnings and alerts. =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->Alert->X'. Example using 'find'; my $foo_path = $an->Storage->find({file => "foo"}); =head1 METHODS Methods in the core 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 error =cut # Later, this will support all the translation and logging methods. For now, just print the error and exit. sub error { my $self = shift; my $parameter = shift; my $an = $self->parent; # $an->Log->entry({log_level => 2, title_key => "tools_log_0001", title_variables => { function => "error" }, message_key => "tools_log_0002", file => $THIS_FILE, line => __LINE__}); # # # Setup default values # my $title_key = $parameter->{title_key} ? $parameter->{title_key} : $an->String->get({key => "an_0004"}); # my $title_variables = $parameter->{title_variables} ? $parameter->{title_variables} : ""; # my $message_key = $parameter->{message_key} ? $parameter->{message_key} : $an->String->get({key => "an_0005"}); # my $message_variables = $parameter->{message_variables} ? $parameter->{message_variables} : ""; # my $code = $parameter->{code} ? $parameter->{code} : 1; # my $file = $parameter->{file} ? $parameter->{file} : $an->String->get({key => "an_0006"}); # my $line = $parameter->{line} ? $parameter->{line} : ""; # #print "$THIS_FILE ".__LINE__."; title_key: [$title_key], title_variables: [$title_variables], message_key: [$message_key], message_variables: [$message_variables], code: [$code], file: [$file], line: [$line]\n"; # # # It is possible for this to become a run-away call, so this helps # # catch when that happens. # $an->_error_count($an->_error_count + 1); # if ($an->_error_count > $an->_error_limit) # { # print "Infinite loop detected while trying to print an error:\n"; # print "- title_key: [$title_key]\n"; # print "- title_variables: [$title_variables]\n"; # print "- message_key: [$message_key]\n"; # print "- message_variables: [$title_variables]\n"; # print "- code: [$code]\n"; # print "- file: [$file]\n"; # print "- line: [$line]\n"; # die "Infinite loop detected while trying to print an error, exiting.\n"; # } # # # If the 'code' is empty and 'message' is "error_\d+", strip that code # # off and use it as the error code. # #print "$THIS_FILE ".__LINE__."; code: [$code], message_key: [$message_key]\n"; # if ((not $code) && ($message_key =~ /error_(\d+)/)) # { # $code = $1; # #print "$THIS_FILE ".__LINE__."; code: [$code], message_key: [$message_key]\n"; # } # # # If the title is a key, translate it. # #print "$THIS_FILE ".__LINE__."; title_key: [$title_key]\n"; # if ($title_key =~ /\w+_\d+$/) # { # $title_key = $an->String->get({ # key => $title_key, # variables => $title_variables, # }); # #print "$THIS_FILE ".__LINE__."; title_key: [$title_key]\n"; # } # # # If the message is a key, translate it. # #print "$THIS_FILE ".__LINE__."; message_key: [$message_key]\n"; # if ($message_key =~ /\w+_\d+$/) # { # $message_key = $an->String->get({ # key => $message_key, # variables => $message_variables, # }); # #print "$THIS_FILE ".__LINE__."; message_key: [$message_key]\n"; # } # # # Set my error string # my $fatal_heading = $an->String->get({key => "an_0002"}); # #print "$THIS_FILE ".__LINE__."; fatal_heading: [$fatal_heading]\n"; # # my $readable_line = $an->Readable->comma($line); # #print "$THIS_FILE ".__LINE__."; readable_line: [$readable_line]\n"; # # ### TODO: Copy this to 'warning'. # # At this point, the title and message keys are the actual messages. # my $error = "\n".$an->String->get({ # key => "an_0007", # variables => { # code => $code, # heading => $fatal_heading, # file => $file, # line => $readable_line, # title => $title_key, # message => $message_key, # }, # })."\n\n"; # #print "$THIS_FILE ".__LINE__."; error: [$error]\n"; # # # Set the internal error flags # $an->Alert->_set_error($error); # $an->Alert->_set_error_code($code); # # # Append "exiting" to the error string if it is fatal. # $error .= $an->String->get({key => "an_0008"})."\n"; # # # Write a copy of the error to the log. # $an->Log->entry({file => $THIS_FILE, level => 0, raw => $error}); # # # If this is a browser calling us, print the footer so that the loading pinwheel goes away. # if ($ENV{'HTTP_REFERER'}) # { # $an->Striker->_footer(); # } # # # Don't actually die, but do print the error, if fatal errors have been globally disabled (as is done # # in the tests). # if (not $an->Alert->no_fatal_errors) # { # if ($ENV{'HTTP_REFERER'}) # { # print "
\n";
# 			print "$error\n" if not $an->Alert->no_fatal_errors;
# 			print "
\n"; # } # else # { # print "$error\n" if not $an->Alert->no_fatal_errors; # } # $an->data->{sys}{footer_printed} = 1; # $an->nice_exit({exit_code => $code}); # } # # return ($code); } 1;