libparanoid-perl 0.36-2 / usr / share / perl5 / Paranoid / Log / Syslog.pm

# 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__

=head1 NAME

Paranoid::Log::Syslog - Log Facility Syslog

=head1 VERSION

$Id: Syslog.pm,v 0.83 2010/06/03 19:04:07 acorliss Exp $

=head1 SYNOPSIS

  use Paranoid::Log;
  
  enableFacility('local3', 'syslog', 'debug', '+');
  enableFacility('local3', 'syslog', 'debug', '+', 'my-daemon');

=head1 DESCRIPTION

This module implements UNIX syslog support for logging purposes.  Which should
seem natural given that the entire B<Paranoid::Log> API is modeled closely
after it.

=head1 SUBROUTINES/METHODS

B<NOTE>:  Given that this module is not intended to be used directly nothing
is exported.

=head2 init

=head2 log

=head2 remove

=head2 dump

=head1 DEPENDENCIES

=over

=item o

L<Paranoid::Debug>

=item o

L<Unix::Syslog>

=back

=head1 BUGS AND LIMITATIONS

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.

=head1 AUTHOR

Arthur Corliss (corliss@digitalmages.com)

=head1 LICENSE AND COPYRIGHT

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)