File Coverage

blib/lib/Log/Log4perl/Layout/RFC3164.pm
Criterion Covered Total %
statement 31 33 93.9
branch 3 6 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 2 2 100.0
total 46 53 86.7


line stmt bran cond sub pod time code
1             package Log::Log4perl::Layout::RFC3164;
2              
3             # See 'https://docs.fluentd.org/v0.12/articles/in_syslog'
4 1     1   111378 use 5.006;
  1         4  
5 1     1   5 use strict;
  1         2  
  1         21  
6 1     1   4 use warnings;
  1         4  
  1         27  
7 1     1   281 use Log::Log4perl::Level;
  1         1354  
  1         3  
8 1     1   391 use Net::Address::IP::Local;
  1         5881  
  1         25  
9              
10 1     1   7 no strict qw(refs);
  1         2  
  1         24  
11 1     1   4 use base qw(Log::Log4perl::Layout);
  1         2  
  1         239  
12              
13             =encoding utf8
14              
15              
16             =head1 NAME
17              
18             Log::Log4perl::Layout::RFC3164 - Layout in RFC3164 format
19              
20             =head1 VERSION
21              
22             Version 0.01
23              
24             =cut
25              
26             our $VERSION = '0.01';
27              
28             =head1 SYNOPSIS
29              
30             This format is useful with the Log::Dispatch::Syslog class.
31             Add this to your configuration file:
32              
33             log4perl.appender.A1=Log::Dispatch::Syslog
34             log4perl.appender.A1.Filter=RangeAll
35             log4perl.appender.A3.ident=bandsman
36             log4perl.appender.A3.layout=Log::Log4perl::Layout::RFC3164
37              
38             =cut
39              
40             =head2 new
41              
42             use Log::Log4perl::Layout::RFC3164;
43             my $layout = Log::Log4perl::Layout::RFC3164->new();
44              
45             =cut
46              
47             sub new {
48 1     1 1 130 my $class = shift;
49 1   33     6 $class = ref ($class) || $class;
50              
51 1         6 return bless {
52             # format => undef,
53             info_needed => {},
54             stack => [],
55             }, $class;
56             }
57              
58             =head2 render
59              
60             Render a message in the correct format.
61              
62             =cut
63              
64             sub render {
65 1     1 1 716 my($self, $message, $category, $priority, $caller_level) = @_;
66              
67 1         7 my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
68              
69 1         30 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
70 1 50       5 if($sec < 10) {
71 0         0 $sec = "0$sec";
72             }
73 1 50       5 if($min < 10) {
74 1         3 $min = "0$min";
75             }
76 1 50       4 if($hour < 10) {
77 0         0 $hour = "0$hour";
78             }
79              
80 1         14 return "<$category$priority>$months[$mon] $mday $min:$hour:$sec " . Net::Address::IP::Local->public_ipv4() . ' ' . $0 . "[$$]: $message";
81             }
82              
83             =head1 AUTHOR
84              
85             Nigel Horne, C<< >>
86              
87             =head1 BUGS
88              
89             Not tested that much yet.
90              
91             =head1 SEE ALSO
92              
93             L
94             L
95              
96             =head1 SUPPORT
97              
98             You can find documentation for this module with the perldoc command.
99              
100             perldoc Log-Log4perl-Layout-RFC3164
101              
102             You can also look for information at:
103              
104             =over 4
105              
106             =item * RT: CPAN's request tracker
107              
108             L
109              
110             =item * AnnoCPAN: Annotated CPAN documentation
111              
112             L
113              
114             =item * CPAN Ratings
115              
116             L
117              
118             =item * Search CPAN
119              
120             L
121              
122             =back
123              
124             =head1 LICENSE AND COPYRIGHT
125              
126             Copyright 2017 Nigel Horne.
127              
128             This program is released under the following licence: GPL2
129              
130             =cut
131              
132             1;