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


line stmt bran cond sub pod time code
1 1     1   423 use 5.008001;
  1         4  
2 1     1   5 use strict;
  1         2  
  1         19  
3 1     1   5 use warnings;
  1         2  
  1         61  
4              
5             package Log::Any::Adapter::Syslog;
6              
7             # ABSTRACT: Send Log::Any logs to syslog
8             our $VERSION = '1.715';
9              
10 1     1   6 use Log::Any::Adapter::Util qw{make_method};
  1         10  
  1         46  
11 1     1   6 use base qw{Log::Any::Adapter::Base};
  1         2  
  1         143  
12              
13 1     1   1914 use Sys::Syslog qw( :DEFAULT setlogsock );
  1         20827  
  1         134  
14 1     1   7 use File::Basename ();
  1         2  
  1         837  
15              
16             my $log_params;
17              
18              
19             # Build log level priorities
20             my @logging_methods = Log::Any->logging_methods;
21             our %logging_levels;
22             for my $i (0..@logging_methods-1) {
23             $logging_levels{$logging_methods[$i]} = $i;
24             }
25             # some common typos
26             $logging_levels{warn} = $logging_levels{warning};
27             $logging_levels{inform} = $logging_levels{info};
28             $logging_levels{err} = $logging_levels{error};
29              
30             sub _min_level {
31 2     2   4 my $self = shift;
32              
33             return $ENV{LOG_LEVEL}
34 2 50 33     6 if $ENV{LOG_LEVEL} && defined $logging_levels{$ENV{LOG_LEVEL}};
35 2 50       5 return 'trace' if $ENV{TRACE};
36 2 50       5 return 'debug' if $ENV{DEBUG};
37 2 50       6 return 'info' if $ENV{VERBOSE};
38 2 50       6 return 'error' if $ENV{QUIET};
39 2         8 return 'trace';
40             }
41              
42             # When initialized we connect to syslog.
43             sub init {
44 3     3 0 6 my ($self) = @_;
45              
46 3   50     107 $self->{name} ||= File::Basename::basename($0) || 'perl';
      66        
47 3   100     13 $self->{options} ||= "pid";
48 3   100     11 $self->{facility} ||= "local7";
49 3   33     14 $self->{log_level} ||= $self->{min_level} || $self->_min_level;
      66        
50              
51 3 50       14 if ( $self->{options} !~ /\D/ ) {
52             # This is a backwards-compatibility shim from previous versions
53             # of Log::Any::Adapter::Syslog that relied on Unix::Syslog.
54             # Unix::Syslog only allowed setting options based on the numeric
55             # macros exported by Unix::Syslog. These macros are not exported
56             # by Sys::Syslog (and Sys::Syslog does not accept them). So, we
57             # map the Unix::Syslog macros onto the equivalent Sys::Syslog
58             # strings.
59 0 0       0 eval { require Unix::Syslog; } or die "Unix::Syslog is required to use numeric options";
  0         0  
60 0         0 my $num_opt = $self->{options};
61 0         0 my %opt_map = (
62             pid => Unix::Syslog::LOG_PID(),
63             cons => Unix::Syslog::LOG_CONS(),
64             odelay => Unix::Syslog::LOG_ODELAY(),
65             ndelay => Unix::Syslog::LOG_NDELAY(),
66             nowait => Unix::Syslog::LOG_NOWAIT(),
67             perror => Unix::Syslog::LOG_PERROR(),
68             );
69 0         0 $self->{options} = join ",", grep { $num_opt & $opt_map{ $_ } } keys %opt_map;
  0         0  
70             }
71              
72             # We want to avoid re-opening the syslog unnecessarily, so only do it if
73             # the parameters have changed or if we don't think Sys::Syslog has
74             # opened a log yet.
75 3         9 my $new_params = $self->_log_params;
76 3 50 66     14 if ((not defined $log_params) or ($log_params ne $new_params) or (not $Sys::Syslog::facility)) {
      33        
77              
78 3         6 $log_params = $new_params;
79 3         10 openlog($self->{name}, $self->{options}, $self->{facility});
80             }
81              
82 3         19 return $self;
83             }
84              
85             sub _log_params {
86 3     3   5 my ($self) = @_;
87             return sprintf('%s;%s;%s',
88 3         17 $self->{options}, $self->{facility}, $self->{name});
89             }
90              
91             # Create logging methods: debug, info, etc.
92             foreach my $method (Log::Any->logging_methods()) {
93             my $priority = {
94             trace => "debug",
95             debug => "debug",
96             info => "info",
97             inform => "info",
98             notice => "notice",
99             warning => "warning",
100             warn => "warning",
101             error => "err",
102             err => "err",
103             critical => "crit",
104             crit => "crit",
105             fatal => "crit",
106             alert => "alert",
107             emergency => "emerg",
108             }->{$method};
109             defined($priority) or $priority = "error"; # unknown, take a guess.
110              
111             make_method($method, sub {
112 12     12   20 my $self = shift;
113             return if $logging_levels{$method} <
114 12 50       33 $logging_levels{$self->{log_level}};
115              
116             # Bad libraries may call Sys::Syslog::closelog() out from under
117             # us. If so, we should re-open the log with our desired
118             # parameters. We likely cannot protect against someone calling
119             # closelog() from outside Perl, but we could include an adaptor
120             # flag that calls openlog()/closelog() with every message if the
121             # program deems it necessary...
122 12 100 66     46 if (( not defined $Sys::Syslog::facility ) or ( $Sys::Syslog::facility ne $self->{facility} )) {
123 1         4 openlog($self->{name}, $self->{options}, $self->{facility});
124             }
125 12         44 syslog($priority, join('', @_))
126             });
127             }
128              
129             # Create detection methods: is_debug, is_info, etc.
130             foreach my $method (Log::Any->detection_methods()) {
131             my $level = $method; $level =~ s/^is_//;
132             make_method($method, sub {
133 13     13   24 my $self = shift;
134 13         58 return $logging_levels{$level} >= $logging_levels{$self->{log_level}};
135             });
136              
137             }
138              
139              
140             1;
141              
142             __END__