Chris/webperl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Syslog facilities added.

Browse Source
This commit is contained in:
Chris 2014-01-12 11:50:20 +00:00
parent 8b7c5f79f7
commit 547f9846b5
1 changed files with 24 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Webperl/Logger.pm
View File

@ -25,6 +25,7 @@
package Webperl::Logger; package Webperl::Logger;
use strict; use strict;
use Sys::Syslog qw(:standard :macros);
require Exporter; require Exporter;
our @ISA = qw(Exporter); our @ISA = qw(Exporter);
our @EXPORT = qw(warn_log die_log); our @EXPORT = qw(warn_log die_log);
@ -59,6 +60,7 @@ BEGIN {
# Defaults to false. # Defaults to false.
# logname - If set, messages sent to warn_log and die_log will be appended # logname - If set, messages sent to warn_log and die_log will be appended
# to the specified log file. See start_log below for more details. # to the specified log file. See start_log below for more details.
# syslog - If set to true, messages are copied into syslog.
# #
# @param args A hash of key, value pairs with which to initialise the object. # @param args A hash of key, value pairs with which to initialise the object.
# @return A new Logging object. # @return A new Logging object.
@ -70,6 +72,8 @@ sub new {
"verbosity" => DEBUG, "verbosity" => DEBUG,
"fatalblargh" => 0, "fatalblargh" => 0,
"outlevels" => [ "WARNING", "NOTICE", "DEBUG" ], "outlevels" => [ "WARNING", "NOTICE", "DEBUG" ],
"syslog" => 0,
"syslog_levs" => [ LOG_WARNING, LOG_NOTICE, LOG_DEBUG ],
@_, @_,
}; };
@ -77,6 +81,15 @@ sub new {
$obj -> start_log($self -> {"logname"}) if($self -> {"logname"}); $obj -> start_log($self -> {"logname"}) if($self -> {"logname"});
# Set up syslog if needed. If open fails, disable syslog again
if($obj -> {"syslog"}) {
eval { openlog($$, "ndelay,pid", LOG_DAEMON); }
if($@) {
$obj -> {"syslog"} = 0;
$obj -> warn_log(undef, "Unable to conenct to syslog: $@");
}
}
# Store as the singleton, just in case # Store as the singleton, just in case
$log_singleton = $obj; $log_singleton = $obj;
@ -256,6 +269,9 @@ sub print {
print $self -> {"outlevels"} -> [$level],": $message",($newline ? "\n" : ""); print $self -> {"outlevels"} -> [$level],": $message",($newline ? "\n" : "");
print $logfile $self -> {"outlevels"} -> [$level],": $message",($newline ? "\n" : "") if($logfile); print $logfile $self -> {"outlevels"} -> [$level],": $message",($newline ? "\n" : "") if($logfile);
syslog($self -> {"syslog_levs"} -> [$level], $message)
if(!$self -> {"syslog"});
# flush stdout if needed to avoid log update delays # flush stdout if needed to avoid log update delays
select((select(STDOUT), $| = 1)[0]) if($newline); select((select(STDOUT), $| = 1)[0]) if($newline);
} }
@ -299,6 +315,11 @@ sub warn_log {
print $logfile scalar(localtime)," [$$:$ip]: $message\n" print $logfile scalar(localtime)," [$$:$ip]: $message\n"
if($logfile); if($logfile);
syslog(LOG_WARNING, $message)
if(!$self -> {"syslog"});
$self -> log("warning", 0, $ip, $message);
warn "[$$:$ip]: $message\n"; warn "[$$:$ip]: $message\n";
} }
@ -323,6 +344,9 @@ sub die_log {
print $logfile scalar(localtime)," [$$:$ip]: $message\n" print $logfile scalar(localtime)," [$$:$ip]: $message\n"
if($logfile); if($logfile);
syslog(LOG_ERR, $message)
if(!$self -> {"syslog"});
$self -> log("fatal", 0, $ip, $message); $self -> log("fatal", 0, $ip, $message);
die "[$$:$ip]: $message\n"; die "[$$:$ip]: $message\n";