File Coverage

blib/lib/Log/Dispatch/Syslog.pm
Criterion Covered Total %
statement 42 49 85.7
branch 6 16 37.5
condition 1 6 16.6
subroutine 11 11 100.0
pod 0 2 0.0
total 60 84 71.4


line stmt bran cond sub pod time code
1             package Log::Dispatch::Syslog;
2              
3 2     2   16023 use strict;
  2         5  
  2         59  
4 2     2   42 use warnings;
  2         16  
  2         85  
5              
6             our $VERSION = '2.71';
7              
8 2     2   17 use Log::Dispatch::Types;
  2         9  
  2         14  
9 2     2   56986 use Params::ValidationCompiler qw( validation_for );
  2         5  
  2         146  
10 2     2   16 use Scalar::Util qw( reftype );
  2         4  
  2         122  
11 2     2   13 use Sys::Syslog 0.28 ();
  2         54  
  2         40  
12 2     2   10 use Try::Tiny;
  2         4  
  2         143  
13              
14 2     2   14 use base qw( Log::Dispatch::Output );
  2         12  
  2         1264  
15              
16             my $thread_lock;
17              
18             {
19             my ($DefaultIdent) = $0 =~ /(.+)/;
20              
21             my $validator = validation_for(
22             params => {
23             ident => {
24              
25             # It's weird to allow an empty string but that's how this
26             # worked pre-PVC.
27             type => t('Str'),
28             default => $DefaultIdent
29             },
30             logopt => {
31             type => t('Str'),
32             default => q{},
33             },
34             facility => {
35             type => t('NonEmptyStr'),
36             default => 'user'
37             },
38             socket => {
39             type => t('SyslogSocket'),
40             default => undef,
41             },
42             lock => {
43             type => t('Bool'),
44             default => 0,
45             },
46             },
47             slurpy => 1,
48             );
49              
50             my $threads_loaded;
51              
52             sub new {
53 3     3 0 28 my $class = shift;
54 3         57 my %p = $validator->(@_);
55              
56 3         176 my $self = bless { map { $_ => delete $p{$_} }
  15         39  
57             qw( ident logopt facility socket lock ) },
58             $class;
59              
60 3 50       23 if ( $self->{lock} ) {
61 0 0       0 unless ($threads_loaded) {
62 0         0 local ( $@, $SIG{__DIE__} ) = ( undef, undef );
63              
64             ## no critic (BuiltinFunctions::ProhibitStringyEval)
65             # These need to be loaded with use, not require.
66 0 0       0 die $@ unless eval 'use threads; use threads::shared; 1;';
67 0         0 $threads_loaded = 1;
68             }
69 0         0 &threads::shared::share( \$thread_lock );
70             }
71              
72 3         21 $self->_basic_init(%p);
73              
74 3         15 return $self;
75             }
76             }
77              
78             {
79             my @priorities = (
80             'DEBUG',
81             'INFO',
82             'NOTICE',
83             'WARNING',
84             'ERR',
85             'CRIT',
86             'ALERT',
87             'EMERG',
88             );
89              
90             sub log_message {
91 3     3 0 7 my $self = shift;
92 3         8 my %p = @_;
93              
94 3         10 my $pri = $self->_level_as_number( $p{level} );
95              
96 3 50       13 lock($thread_lock) if $self->{lock};
97              
98             return
99             if try {
100 3 100   3   108 if ( defined $self->{socket} ) {
101             Sys::Syslog::setlogsock(
102             ref $self->{socket}
103             && reftype( $self->{socket} ) eq 'ARRAY'
104 0         0 ? @{ $self->{socket} }
105             : $self->{socket}
106 2 50 33     29 );
107             }
108              
109             Sys::Syslog::openlog(
110             $self->{ident},
111             $self->{logopt},
112             $self->{facility}
113 3         26 );
114 3         14 Sys::Syslog::syslog( $priorities[$pri], $p{message} );
115 3         16 Sys::Syslog::closelog();
116              
117 3         10 1;
118 3 50       23 };
119              
120 0 0 0       warn $@ if $@ and $^W;
121             }
122             }
123              
124             1;
125              
126             # ABSTRACT: Object for logging to system log.
127              
128             __END__
129              
130             =pod
131              
132             =encoding UTF-8
133              
134             =head1 NAME
135              
136             Log::Dispatch::Syslog - Object for logging to system log.
137              
138             =head1 VERSION
139              
140             version 2.71
141              
142             =head1 SYNOPSIS
143              
144             use Log::Dispatch;
145              
146             my $log = Log::Dispatch->new(
147             outputs => [
148             [
149             'Syslog',
150             min_level => 'info',
151             ident => 'Yadda yadda'
152             ]
153             ]
154             );
155              
156             $log->emerg("Time to die.");
157              
158             =head1 DESCRIPTION
159              
160             This module provides a simple object for sending messages to the system log
161             (via UNIX syslog calls).
162              
163             Note that logging may fail if you try to pass UTF-8 characters in the log
164             message. If logging fails and warnings are enabled, the error message will be
165             output using Perl's C<warn>.
166              
167             =for Pod::Coverage new log_message
168              
169             =head1 CONSTRUCTOR
170              
171             The constructor takes the following parameters in addition to the standard
172             parameters documented in L<Log::Dispatch::Output>:
173              
174             =over 4
175              
176             =item * ident ($)
177              
178             This string will be prepended to all messages in the system log. Defaults to
179             $0.
180              
181             =item * logopt ($)
182              
183             A string containing the log options (separated by any separator you like). See
184             the openlog(3) and Sys::Syslog docs for more details. Defaults to ''.
185              
186             =item * facility ($)
187              
188             Specifies what type of program is doing the logging to the system log. Valid
189             options are 'auth', 'authpriv', 'cron', 'daemon', 'kern', 'local0' through
190             'local7', 'mail, 'news', 'syslog', 'user', 'uucp'. Defaults to 'user'
191              
192             =item * socket ($, \@, or \%)
193              
194             Tells what type of socket to use for sending syslog messages. Valid options are
195             listed in C<Sys::Syslog>.
196              
197             If you don't provide this, then we let C<Sys::Syslog> simply pick one that
198             works, which is the preferred option, as it makes your code more portable.
199              
200             If you pass an array reference, it is dereferenced and passed to
201             C<Sys::Syslog::setlogsock()>.
202              
203             If you pass a hash reference, it is passed to C<Sys::Syslog::setlogsock()> as
204             is.
205              
206             =item * lock ($)
207              
208             If this is set to a true value, then the calls to C<setlogsock()>,
209             C<openlog()>, C<syslog()>, and C<closelog()> will all be guarded by a
210             thread-locked variable.
211              
212             This is only relevant when running you are using Perl threads in your
213             application. Setting this to a true value will cause the L<threads> and
214             L<threads::shared> modules to be loaded.
215              
216             This defaults to false.
217              
218             =back
219              
220             =head1 SUPPORT
221              
222             Bugs may be submitted at L<https://github.com/houseabsolute/Log-Dispatch/issues>.
223              
224             =head1 SOURCE
225              
226             The source code repository for Log-Dispatch can be found at L<https://github.com/houseabsolute/Log-Dispatch>.
227              
228             =head1 AUTHOR
229              
230             Dave Rolsky <autarch@urth.org>
231              
232             =head1 COPYRIGHT AND LICENSE
233              
234             This software is Copyright (c) 2023 by Dave Rolsky.
235              
236             This is free software, licensed under:
237              
238             The Artistic License 2.0 (GPL Compatible)
239              
240             The full text of the license can be found in the
241             F<LICENSE> file included with this distribution.
242              
243             =cut