| Paranoid documentation | Contained in the Paranoid distribution. |
Paranoid::Log::Syslog - Log Facility Syslog
$Id: Syslog.pm,v 0.83 2010/06/03 19:04:07 acorliss Exp $
use Paranoid::Log;
enableFacility('local3', 'syslog', 'debug', '+');
enableFacility('local3', 'syslog', 'debug', '+', 'my-daemon');
This module implements UNIX syslog support for logging purposes. Which should seem natural given that the entire Paranoid::Log API is modeled closely after it.
NOTE: Given that this module is not intended to be used directly nothing is exported.
Because we're keeping a connection to the syslogger open we don't support enabling multiple facilities that log as different idents, etc. The first syslog facility that gets activated will set those parameters.
Arthur Corliss (corliss@digitalmages.com)
This software is licensed under the same terms as Perl, itself. Please see http://dev.perl.org/licenses/ for more information.
(c) 2005, Arthur Corliss (corliss@digitalmages.com)
| Paranoid documentation | Contained in the Paranoid distribution. |
# Paranoid::Log::Syslog -- Log Facility Syslog for paranoid programs # # (c) 2005, Arthur Corliss <corliss@digitalmages.com> # # $Id: Syslog.pm,v 0.83 2010/06/03 19:04:07 acorliss Exp $ # # This software is licensed under the same terms as Perl, itself. # Please see http://dev.perl.org/licenses/ for more information. # ##################################################################### ##################################################################### # # Environment definitions # ##################################################################### package Paranoid::Log::Syslog; use 5.006; use strict; use warnings; use vars qw($VERSION); use Paranoid::Debug qw(:all); use Unix::Syslog qw(:macros :subs); use Carp; ($VERSION) = ( q$Revision: 0.83 $ =~ /(\d+(?:\.(\d+))+)/sm ); ##################################################################### # # Module code follows # ##################################################################### sub _setIdent (;$) { # Purpose: Returns a name for use as the ident field. If you don't want # the process command as that you can pass an optional name to # use instead. # Returns: String # Usage: $ident = _setIdent(); # Usage: $ident = _setIdent($name); my $name = shift; # Use $0 by default $name = $0 unless defined $name; # Strip path $name =~ s#^.*/##sm; return $name; } sub init (;@) { # Purpose: Exists purely for compliance. # Returns: True (1) # Usage: init(); return 1; } sub _transFacility ($) { # Purpose: Translates the string log facilities into the syslog constants # Returns: Constant scalar value # Usage: $facility = _transFacility($facilityName); my $f = lc shift; my %trans = ( authpriv => LOG_AUTHPRIV, auth => LOG_AUTHPRIV, cron => LOG_CRON, daemon => LOG_DAEMON, ftp => LOG_FTP, kern => LOG_KERN, local0 => LOG_LOCAL0, local1 => LOG_LOCAL1, local2 => LOG_LOCAL2, local3 => LOG_LOCAL3, local4 => LOG_LOCAL4, local5 => LOG_LOCAL5, local6 => LOG_LOCAL6, local7 => LOG_LOCAL7, lpr => LOG_LPR, mail => LOG_MAIL, news => LOG_NEWS, syslog => LOG_SYSLOG, user => LOG_USER, uucp => LOG_UUCP, ); return exists $trans{$f} ? $trans{$f} : undef; } sub _transLevel ($) { # Purpose: Translates the passed log level string into the syslog # constant # Returns: Constant scalar value # Usage: $level = _transLevel($levelName); my $l = lc shift; my %trans = ( 'debug' => LOG_DEBUG, 'info' => LOG_INFO, 'notice' => LOG_NOTICE, 'warn' => LOG_WARNING, 'warning' => LOG_WARNING, 'err' => LOG_ERR, 'error' => LOG_ERR, 'crit' => LOG_CRIT, 'critical' => LOG_CRIT, 'alert' => LOG_ALERT, 'emerg' => LOG_EMERG, 'emergency' => LOG_EMERG, 'panic' => LOG_EMERG, ); return exists $trans{$l} ? $trans{$l} : undef; } { my $sysopened = 0; sub _openSyslog (;$$) { # Purpose: If the syslogger hasn't been opened yet it opens it, # otherwise exits cleanly. # Returns: True (1) if successful, # False (0) if there are any errors # Usage: $rv = _openSyslog(); # Usage: $rv = _openSyslog($ident); # Usage: $rv = _openSyslog($ident, $facility); my $ident = shift; my $facility = shift; my $i = defined $ident ? $ident : 'undef'; my $f = defined $facility ? $facility : 'undef'; pdebug( "entering w/($i)($f)", PDLEVEL2 ); pIn(); # Open a handle to the syslog daemon unless ($sysopened) { # Make sure both values are set $ident = _setIdent($ident); $facility = 'user' unless defined $facility; # Validate the facility croak 'Can\'t open handle to syslogger with an invalid facility: ' . "$facility\n" unless defined( $facility = _transFacility($facility) ); # Open the logger openlog $ident, LOG_CONS | LOG_NDELAY | LOG_PID, $facility; $sysopened = 1; # TODO: trap return value of openlog? } pOut(); pdebug( "leaving w/rv: $sysopened", PDLEVEL2 ); return $sysopened; } sub remove (;$) { # Purpose: Closes the syslogger # Returns: True (1) # Usage: remove(); pdebug( 'entering', PDLEVEL2 ); closelog(); $sysopened = 0; pdebug( 'leaving w/rv: 1', PDLEVEL2 ); return 1; } } sub log ($$$$$$$) { # Purpose: Logs the passed message to the named file # Returns: Return value of print() # Usage: log($msgtime, $severity, $message, $name, $facility, $level, # $scope); # Usage: log($msgtime, $severity, $message, $name, $facility, $level, # $scope, $progName); my $msgtime = shift; my $severity = shift; my $message = shift; my $name = shift; my $facility = shift; my $level = shift; my $scope = shift; my $rv = 0; # Set defaults on optional args $name = 'user' unless defined $name; $severity = 'notice' unless defined $severity; # Validate arguments croak 'Mandatory second argument must be a valid severity' unless defined _transLevel($severity); croak 'Mandatory third argument must be a valid message' unless defined $message; croak 'Mandatory fourth argument must be a valid syslog facility' unless defined _transFacility($name); pdebug( "entering w/($msgtime)($severity)($message)($name)" . "($facility)($level)($scope)", PDLEVEL1 ); pIn(); # TODO: Make sure prog name works? # Make sure the logger is ready and log the message if ( _openSyslog( undef, $name ) ) { syslog _transLevel($severity), '%s', $message; $rv = 1; } pOut(); pdebug( "leaving w/rv: $rv", PDLEVEL1 ); return $rv; } sub dump() { # Purpose: Exists purely for compliance. # Returns: True (1) # Usage: init(); return (); } 1; __END__