File Coverage

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

Criterion	Covered	Total	%
statement	31	32	96.8
branch	2	2	100.0
condition	10	14	71.4
subroutine	9	10	90.0
pod	0	1	0.0
total	52	59	88.1

package Log::Any::Adapter::Syslog;
use strict;
use warnings;

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

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

use Unix::Syslog qw{:macros :subs};
use File::Basename ();

my $log_params;

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

    $self->{name}     ||= File::Basename::basename($0) || 'perl';
    $self->{options}  ||= LOG_PID;
    $self->{facility} ||= LOG_LOCAL7;

    # We want to avoid re-opening the syslog unnecessarily, so only do it if
    # the parameters have changed.
    my $new_params = $self->_log_params;
    if ((not defined $log_params) or ($log_params ne $new_params)) {

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

    return $self;
}

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

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

    make_method($method, sub { shift; syslog($priority, '%s', join('', @_)) });
}

# Create detection methods: is_debug, is_info, etc.
my $always_on = sub { 1; };
foreach my $method (Log::Any->detection_methods()) {
    make_method($method, $always_on);
}


1;



=pod

=head1 NAME

Log::Any::Adapter::Syslog - Send Log::Any logs to syslog

=head1 VERSION

version 1.5

=head1 SYNOPSIS

    use Log::Any::Adapter;
    Log::Any::Adapter->set('Syslog');

    # You can override defaults:
    use Unix::Syslog qw{:macros};
    Log::Any::Adapter->set(
        'Syslog',
        # name defaults to basename($0)
        name     => 'my-name',
        # options default to LOG_PID
        options  => LOG_PID|LOG_PERROR,
        # facility defaults to LOG_LOCAL7
        facility => LOG_LOCAL7
    );

=head1 DESCRIPTION

L is a generic adapter for writing logging into Perl modules; this
adapter use the L module to direct that output into the standard
Unix syslog system.

=head1 CONFIGURATION

C is designed to work out of the box with no
configuration required; the defaults should be reasonably sensible.

You can override the default configuration by passing extra arguments to the
C method:

=over

=item name

The I argument defaults to the basename of C<$0> if not supplied, and is
inserted into each line sent to syslog to identify the source.

=item options

The I configure the behaviour of syslog; see L for
details.

The default is C, which includes the PID of the current process after
the process name:

    example-process[2345]: something amazing!

The most likely addition to that is C which causes syslog to also
send a copy of all log messages to the controlling terminal of the process.

B If you pass a defined value you are setting, not augmenting, the
options.  So, if you want C as well as other flags, pass them all.

=item facility

The I determines where syslog sends your messages.  The default is
C, which is not the most useful value ever, but is less bad than
assuming the fixed facilities.

See L and L for details on the available facilities.

=back

=head1 AUTHORS

=over 4

=item *

Daniel Pittman

=item *

Stephen Thirlwall

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Stephen Thirlwall.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__