File Coverage

blib/lib/Log/Any/Adapter/Syslog.pm

Criterion	Covered	Total	%
statement	47	53	88.6
branch	10	20	50.0
condition	16	27	59.2
subroutine	12	12	100.0
pod	0	1	0.0
total	85	113	75.2

use 5.008001;
use strict;
use warnings;

package Log::Any::Adapter::Syslog;

# ABSTRACT: Send Log::Any logs to syslog
our $VERSION = '1.716';

use Log::Any::Adapter::Util qw{make_method};
use base qw{Log::Any::Adapter::Base};

use Sys::Syslog qw( :DEFAULT setlogsock );
use File::Basename ();

my $log_params;


# Build log level priorities
my @logging_methods = Log::Any->logging_methods;
our %logging_levels;
for my $i (0..@logging_methods-1) {
    $logging_levels{$logging_methods[$i]} = $i;
}
# some common typos
$logging_levels{warn} = $logging_levels{warning};
$logging_levels{inform} = $logging_levels{info};
$logging_levels{err} = $logging_levels{error};

sub _min_level {
    my $self = shift;

    return $ENV{LOG_LEVEL}
        if $ENV{LOG_LEVEL} && defined $logging_levels{$ENV{LOG_LEVEL}};
    return 'trace' if $ENV{TRACE};
    return 'debug' if $ENV{DEBUG};
    return 'info'  if $ENV{VERBOSE};
    return 'error' if $ENV{QUIET};
    return 'trace';
}

# When initialized we connect to syslog.
sub init {
    my ($self) = @_;

    $self->{name}     ||= File::Basename::basename($0) || 'perl';
    $self->{options}  ||= "pid";
    $self->{facility} ||= "local7";
    $self->{log_level} ||= $self->{min_level} || $self->_min_level;

    if ( $self->{options} !~ /\D/ ) {
        # This is a backwards-compatibility shim from previous versions
        # of Log::Any::Adapter::Syslog that relied on Unix::Syslog.
        # Unix::Syslog only allowed setting options based on the numeric
        # macros exported by Unix::Syslog. These macros are not exported
        # by Sys::Syslog (and Sys::Syslog does not accept them). So, we
        # map the Unix::Syslog macros onto the equivalent Sys::Syslog
        # strings.
        eval { require Unix::Syslog; } or die "Unix::Syslog is required to use numeric options";
        my $num_opt = $self->{options};
        my %opt_map = (
            pid => Unix::Syslog::LOG_PID(),
            cons => Unix::Syslog::LOG_CONS(),
            odelay => Unix::Syslog::LOG_ODELAY(),
            ndelay => Unix::Syslog::LOG_NDELAY(),
            nowait => Unix::Syslog::LOG_NOWAIT(),
            perror => Unix::Syslog::LOG_PERROR(),
        );
        $self->{options} = join ",", grep { $num_opt & $opt_map{ $_ } } keys %opt_map;
    }

    # We want to avoid re-opening the syslog unnecessarily, so only do it if
    # the parameters have changed or if we don't think Sys::Syslog has
    # opened a log yet.
    my $new_params = $self->_log_params;
    if ((not defined $log_params) or ($log_params ne $new_params) or (not $Sys::Syslog::facility)) {

        $log_params = $new_params;
        openlog($self->{name}, $self->{options}, $self->{facility});
    }

    return $self;
}

sub _log_params {
    my ($self) = @_;
    return sprintf('%s;%s;%s',
        $self->{options}, $self->{facility}, $self->{name});
}

# Create logging methods: debug, info, etc.
foreach my $method (Log::Any->logging_methods()) {
    my $priority = {
        trace     => "debug",
        debug     => "debug",
        info      => "info",
        inform    => "info",
        notice    => "notice",
        warning   => "warning",
        warn      => "warning",
        error     => "err",
        err       => "err",
        critical  => "crit",
        crit      => "crit",
        fatal     => "crit",
        alert     => "alert",
        emergency => "emerg",
    }->{$method};
    defined($priority) or $priority = "error"; # unknown, take a guess.

    make_method($method, sub {
        my $self = shift;
        return if $logging_levels{$method} <
                $logging_levels{$self->{log_level}};

        # Bad libraries may call Sys::Syslog::closelog() out from under
        # us. If so, we should re-open the log with our desired
        # parameters. We likely cannot protect against someone calling
        # closelog() from outside Perl, but we could include an adaptor
        # flag that calls openlog()/closelog() with every message if the
        # program deems it necessary...
        if (( not defined $Sys::Syslog::facility ) or ( $Sys::Syslog::facility ne $self->{facility} )) {
          openlog($self->{name}, $self->{options}, $self->{facility});
        }
        syslog($priority, join('', @_))
    });
}

# Create detection methods: is_debug, is_info, etc.
foreach my $method (Log::Any->detection_methods()) {
    my $level = $method; $level =~ s/^is_//;
    make_method($method, sub {
        my $self = shift;
        return $logging_levels{$level} >= $logging_levels{$self->{log_level}};
    });

}


1;

__END__