File Coverage

blib/lib/Log/Log4perl/Appender/Fluent.pm
Criterion Covered Total %
statement 15 44 34.0
branch 0 18 0.0
condition 0 9 0.0
subroutine 5 7 71.4
pod 2 2 100.0
total 22 80 27.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             =head1 NAME
4              
5             Log::Log4perl::Appender::Fluent - log appender writing to Fluentd
6              
7             =head1 SYNOPSIS
8              
9             log4perl.category = INFO, Fluentd
10             # ...
11             log4perl.appender.Fluentd = Log::Log4perl::Appender::Fluent
12             log4perl.appender.Fluentd.host = fluentd.example.net
13             # this port is default for Fluentd
14             #log4perl.appender.Fluentd.port = 24224
15             log4perl.appender.Fluentd.hostname_field = source_host
16             log4perl.appender.Fluentd.tag_prefix = example
17             # these two options prevent the message from being stringified
18             log4perl.appender.Fluentd.layout = Log::Log4perl::Layout::NoopLayout
19             log4perl.appender.Fluentd.warp_message = 0
20              
21             =head1 DESCRIPTION
22              
23             Log::Log4perl::Appender::Fluent is a L appender plugin that
24             provides output to Fluentd daemon. The plugin supports sending simple string
25             messages, but it works way better when is provided with
26             L or L object, because the
27             structure of the message will be preserved.
28              
29             =cut
30              
31             package Log::Log4perl::Appender::Fluent;
32              
33 1     1   84163 use warnings;
  1         2  
  1         43  
34 1     1   8 use strict;
  1         1  
  1         26  
35              
36 1     1   5 use base qw{Log::Log4perl::Appender};
  1         4  
  1         83  
37 1     1   291 use Fluent::Logger;
  1         52453  
  1         25  
38 1     1   7 use Sys::Hostname;
  1         1  
  1         323  
39              
40             #-----------------------------------------------------------------------------
41              
42             our $VERSION = '0.05';
43              
44             #-----------------------------------------------------------------------------
45              
46             =head1 USAGE
47              
48             Following options are available in L config:
49              
50             =cut
51              
52             #-----------------------------------------------------------------------------
53              
54             =over
55              
56             =item I (default: I)
57              
58             Path to UNIX socket, where Fluentd listens. If specified, communication with
59             Fluentd instance will go through this socket, otherwise TCP protocol will be
60             used.
61              
62             =item I, I (default: C, C<24224>)
63              
64             Fluentd instance's address. If neither host/port nor socket is specified,
65             due to default values, TCP communication will take place.
66              
67             =item I (default: C)
68              
69             Communication with Fluentd imposes using hashes as messages. This option
70             tells how should be named key if the message is not
71             a L/L object.
72              
73             =item I (default: I)
74              
75             Fluentd on its own doesn't provide the information where the record comes
76             from. Setting I will make this module to add (replace)
77             necessary field in messages.
78              
79             =item I, I (default: I, I)
80              
81             These options, similarly to I, specify where to put message's
82             category and level.
83              
84             =item I, I (default: I, I)
85              
86             If I is set, this will be the tag for messages. If I is set,
87             message will have the tag set to this prefix plus message's category. If
88             neither I nor I is set, message's tag is equal to category.
89              
90             I has the precedence from these two if both set.
91              
92             =back
93              
94             =head1 METHODS
95              
96             =head2 new
97              
98             Constructor method
99              
100             =cut
101              
102             sub new {
103 0     0 1   my ($class, %options) = @_;
104              
105             my $self = bless {
106             unix => $options{socket},
107             tcp => {
108             host => $options{host} || 'localhost',
109             port => $options{port} || 24224,
110             },
111             message_field => $options{message_field} || 'message',
112             hostname_field => $options{hostname_field},
113             tag_prefix => $options{tag_prefix},
114             tag => $options{tag},
115              
116 0   0       fluent => undef,
      0        
      0        
117             }, $class;
118              
119 0 0         if ($self->{unix}) {
120             $self->{fluent} = new Fluent::Logger(
121             socket => $self->{unix},
122 0           );
123             } else {
124             $self->{fluent} = new Fluent::Logger(
125             host => $self->{tcp}{host},
126             port => $self->{tcp}{port},
127 0           );
128             }
129              
130 0           return $self;
131             }
132              
133             =head2 log
134              
135             Log method
136              
137             =cut
138              
139             sub log {
140 0     0 1   my ($self, %params) = @_;
141              
142 0           my $msg = $params{message};
143 0           my $category = $params{log4p_category};
144 0           my $level = $params{log4p_level};
145              
146             # possibly strip one array level
147 0 0 0       $msg = $msg->[0] if ref $msg eq 'ARRAY' && @$msg == 1;
148              
149             # repack message
150 0 0         if (eval { $msg->isa('Log::Message::JSON') }) {
  0 0          
151             # strip Log::Message::JSON blessing
152             # NOTE: the resulting hash(ref) should be tied to Tie::IxHash, but there's
153             # a bug in Data::MessagePack 0.38 (XS version)
154 0           $msg = { %$msg };
155 0           } elsif (eval { $msg->DOES("Log::Message::Structured") }) {
156             # Log::Message::Structured support
157             # such a message:
158             # * is a Moose object
159             # * has Log::Message::Structured role
160             # * has method as_hash()
161 0           $msg = $msg->as_hash;
162             } else {
163 0           $msg = { $self->{message_field} => $msg };
164             }
165              
166             # add (replace?) fields: hostname, category (facility), level (importance)
167 0 0         if ($self->{hostname_field}) {
168 0           $msg->{ $self->{hostname_field} } = hostname();
169             }
170 0 0         if ($self->{category_field}) {
171 0           $msg->{ $self->{category_field} } = $category;
172             }
173 0 0         if ($self->{level_field}) {
174 0           $msg->{ $self->{level_field} } = $level;
175             }
176              
177 0           my $tag;
178 0 0         if ($self->{tag}) {
    0          
179 0           $tag = $self->{tag};
180             } elsif ($self->{tag_prefix}) {
181 0           $tag = "$self->{tag_prefix}.$category";
182             } else {
183 0           $tag = $category;
184             }
185              
186             # TODO: what if error? there was carp() somewhere
187 0           $self->{fluent}->post($tag, $msg);
188             }
189              
190             #-----------------------------------------------------------------------------
191              
192             =head1 NOTES
193              
194             If the destination host is unavailable, this module may print error messages
195             using C.
196              
197             =head1 AUTHOR
198              
199             Stanislaw Klekot, C<< >>
200              
201             =head1 LICENSE AND COPYRIGHT
202              
203             Copyright 2012 Stanislaw Klekot.
204              
205             This program is free software; you can redistribute it and/or modify it
206             under the terms of either: the GNU General Public License as published
207             by the Free Software Foundation; or the Artistic License.
208              
209             See http://dev.perl.org/licenses/ for more information.
210              
211             =head1 SEE ALSO
212              
213             http://fluentd.org/, L, L,
214             L.
215              
216             =cut
217              
218             #-----------------------------------------------------------------------------
219             1;
220             # vim:ft=perl