169 lines
3.7 KiB
Perl
169 lines
3.7 KiB
Perl
package ACU::Log;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use utf8;
|
|
use open IO => ':utf8';
|
|
use open ':std';
|
|
|
|
use Data::Dumper;
|
|
use Exporter 'import';
|
|
use POSIX qw(strftime);
|
|
use Term::ANSIColor qw(:constants);
|
|
|
|
use constant {
|
|
FATAL => 1,
|
|
ALERT => 2,
|
|
ERROR => 3,
|
|
WARN => 4,
|
|
DONE => 5,
|
|
USAGE => 6,
|
|
PENDING => 6.5,
|
|
INFO => 7,
|
|
DEBUG => 8,
|
|
TRACE => 9,
|
|
};
|
|
|
|
our @EXPORT = qw(log FATAL ALERT ERROR WARN DONE USAGE PENDING INFO DEBUG TRACE);
|
|
|
|
our $display_level = 7;
|
|
our $save_level = 9;
|
|
our $fatal_error = 1;
|
|
our $fatal_warn = 0;
|
|
our $mail_error = 0;
|
|
|
|
our $log_file = $0.".log";
|
|
my $log_fd;
|
|
|
|
my $HOSTNAME = `hostname`;
|
|
chomp($HOSTNAME);
|
|
|
|
sub log
|
|
{
|
|
my $level = shift;
|
|
|
|
if ($#_ < 0) { return; }
|
|
if (!$_[0]) {
|
|
$Carp::Verbose = 1;
|
|
croak "Empty log message, this should not append!";
|
|
}
|
|
|
|
if (!$log_fd && $log_file) {
|
|
open ($log_fd, ">>", $log_file) or croak("Unable to open log ($log_file) file for writing");
|
|
|
|
# Enable autoflush for the log file
|
|
my $previous_default = select($log_fd);
|
|
$|++;
|
|
select($previous_default);
|
|
|
|
say $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " START new logging session ";
|
|
}
|
|
|
|
if ($level <= $save_level and $log_fd)
|
|
{
|
|
print $log_fd strftime("%a %b %e %H:%M:%S %Y", localtime), " ", levelstr($level), " ";
|
|
|
|
if ($level == TRACE) {
|
|
print $log_fd Dumper(@_);
|
|
}
|
|
else {
|
|
say $log_fd @_;
|
|
}
|
|
}
|
|
|
|
if ($mail_error && $level <= ERROR)
|
|
{
|
|
require Email::MIME;
|
|
require Email::Sender::Simple;
|
|
Email::Sender::Simple->import(qw(sendmail));
|
|
my $mail = Email::MIME->create(
|
|
header_str => [
|
|
From => "Roots assistants <root\@$HOSTNAME.acu.epita.fr>",
|
|
To => "Roots assistants <ml-root\@acu.epita.fr>",
|
|
Subject => "[LERDORF][ERROR] ".join(' ', @_)
|
|
],
|
|
attributes => {
|
|
encoding => 'quoted-printable',
|
|
charset => 'utf-8',
|
|
format => 'flowed',
|
|
},
|
|
body_str => "Bonjour,
|
|
|
|
Une erreur de niveau $level est survenue sur la machine $HOSTNAME.
|
|
|
|
Cette erreur est survenue lors de l'exécution du script :
|
|
$0.
|
|
|
|
Voici le contenu du message d'erreur :
|
|
".join(' ', @_)."
|
|
|
|
Cordialement,
|
|
|
|
--
|
|
The lerdorf project",
|
|
);
|
|
sendmail($mail);
|
|
}
|
|
|
|
if ($level <= $display_level)
|
|
{
|
|
$|++; # Autoflush STDOUT
|
|
|
|
if ($level == PENDING) {
|
|
print STDERR (leveldisp($level), @_, RESET, "\r");
|
|
} else {
|
|
say STDERR (leveldisp($level), @_, RESET);
|
|
}
|
|
|
|
$|--; # Disable autoflush
|
|
}
|
|
|
|
if ($fatal_warn && $level <= WARN){
|
|
#log(INFO, "Program stopped due to warning");
|
|
exit 125;
|
|
}
|
|
elsif ($fatal_error && $level <= ERROR) {
|
|
#log(INFO, "Program stopped due to error");
|
|
exit 126;
|
|
}
|
|
elsif ($level <= FATAL) {
|
|
#log(INFO, "Program stopped due to fatal error");
|
|
exit 127;
|
|
}
|
|
}
|
|
|
|
sub levelstr($)
|
|
{
|
|
my $level = shift;
|
|
|
|
return "FATAL" if ($level <= 1);
|
|
return "ALERT" if ($level <= 2);
|
|
return "ERROR" if ($level <= 3);
|
|
return "WARN " if ($level <= 4);
|
|
return "DONE " if ($level <= 5);
|
|
return "USAGE" if ($level <= 6);
|
|
return "INFO " if ($level <= 7);
|
|
return "DEBUG" if ($level <= 8);
|
|
return "TRACE";
|
|
}
|
|
|
|
sub leveldisp($)
|
|
{
|
|
my $level = shift;
|
|
|
|
return BOLD, ON_RED, YELLOW, "/!\\", RESET, " ", BOLD if ($level <= 1);
|
|
return BOLD, ON_RED, ">>>", RESET, " ", BOLD if ($level <= 2);
|
|
return BOLD, RED, ">>>", RESET, " ", BOLD if ($level <= 3);
|
|
return BOLD, YELLOW, ">>>", RESET, " ", BOLD if ($level <= 4);
|
|
return BOLD, GREEN, ">>>", RESET, " ", BOLD if ($level <= 5);
|
|
return BOLD, MAGENTA, " * ", RESET, " ", BOLD if ($level <= 6);
|
|
return BOLD, CYAN, ">>>", RESET, " " if ($level < 7);
|
|
return BOLD, CYAN, " * ", RESET, " " if ($level == 7);
|
|
return BOLD, BLUE, " % ", RESET, " " if ($level <= 8);
|
|
return BOLD, BLUE, "#", RESET, " ";
|
|
}
|
|
|
|
1;
|