File Coverage

blib/lib/Log/Log4perl/Filter.pm
Criterion Covered Total %
statement 41 43 95.3
branch 5 8 62.5
condition n/a
subroutine 11 11 100.0
pod 0 5 0.0
total 57 67 85.0


line stmt bran cond sub pod time code
1             ##################################################
2             ##################################################
3              
4             use 5.006;
5 70     70   1191 use strict;
  70         204  
6 70     70   365 use warnings;
  70         112  
  70         1339  
7 70     70   311  
  70         147  
  70         1844  
8             use Log::Log4perl::Level;
9 70     70   343 use Log::Log4perl::Config;
  70         143  
  70         414  
10 70     70   33386  
  70         175  
  70         2112  
11             use constant _INTERNAL_DEBUG => 0;
12 70     70   501  
  70         134  
  70         25179  
13             our %FILTERS_DEFINED = ();
14              
15             ##################################################
16             ##################################################
17             my($class, $name, $action) = @_;
18            
19 4     4 0 8 print "Creating filter $name\n" if _INTERNAL_DEBUG;
20              
21 4         5 my $self = { name => $name };
22             bless $self, $class;
23 4         9  
24 4         6 if(ref($action) eq "CODE") {
25             # it's a code ref
26 4 50       14 $self->{ok} = $action;
27             } else {
28 4         11 # it's something else
29             die "Code for ($name/$action) not properly defined";
30             }
31 0         0  
32             return $self;
33             }
34 4         8  
35             ##################################################
36             # (Passed on to subclasses)
37             ##################################################
38             my($self) = @_;
39              
40             by_name($self->{name}, $self);
41 19     19 0 28 }
42              
43 19         51 ##################################################
44             ##################################################
45             my($name, $value) = @_;
46              
47             if(defined $value) {
48             $FILTERS_DEFINED{$name} = $value;
49 38     38 0 58 }
50              
51 38 100       63 if(exists $FILTERS_DEFINED{$name}) {
52 19         27 return $FILTERS_DEFINED{$name};
53             } else {
54             return undef;
55 38 50       64 }
56 38         81 }
57              
58 0         0 ##################################################
59             ##################################################
60             %FILTERS_DEFINED = ();
61             }
62              
63             ##################################################
64             ##################################################
65 295     295 0 696 my($self, %p) = @_;
66              
67             print "Calling $self->{name}'s ok method\n" if _INTERNAL_DEBUG;
68              
69             # Force filter classes to define their own
70             # ok(). Exempt are only sub {..} ok functions,
71 7     7 0 27 # defined in the conf file.
72             die "This is to be overridden by the filter" unless
73 7         8 defined $self->{ok};
74              
75             # What should we set the message in $_ to? The most logical
76             # approach seems to be to concat all parts together. If some
77             # filter wants to dissect the parts, it still can examine %p,
78             # which gets passed to the subroutine and contains the chunks
79 7 50       17 # in $p{message}.
80             # Split because of CVS
81             local($_) = join $
82             Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}};
83             print "\$_ is '$_'\n" if _INTERNAL_DEBUG;
84              
85             my $decision = $self->{ok}->(%p);
86              
87             print "$self->{name}'s ok'ed: ",
88 7         9 ($decision ? "yes" : "no"), "\n" if _INTERNAL_DEBUG;
  7         17  
89 7         8  
90             return $decision;
91 7         132 }
92              
93 7         11 1;
94              
95              
96 7         61 =encoding utf8
97              
98             =head1 NAME
99              
100             Log::Log4perl::Filter - Log4perl Custom Filter Base Class
101              
102             =head1 SYNOPSIS
103              
104             use Log::Log4perl;
105              
106             Log::Log4perl->init(\ <<'EOT');
107             log4perl.logger = INFO, Screen
108             log4perl.filter.MyFilter = sub { /let this through/ }
109             log4perl.appender.Screen = Log::Log4perl::Appender::Screen
110             log4perl.appender.Screen.Filter = MyFilter
111             log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
112             EOT
113              
114             # Define a logger
115             my $logger = Log::Log4perl->get_logger("Some");
116              
117             # Let this through
118             $logger->info("Here's the info, let this through!");
119              
120             # Suppress this
121             $logger->info("Here's the info, suppress this!");
122              
123             #################################################################
124             # StringMatch Filter:
125             #################################################################
126             log4perl.filter.M1 = Log::Log4perl::Filter::StringMatch
127             log4perl.filter.M1.StringToMatch = let this through
128             log4perl.filter.M1.AcceptOnMatch = true
129              
130             #################################################################
131             # LevelMatch Filter:
132             #################################################################
133             log4perl.filter.M1 = Log::Log4perl::Filter::LevelMatch
134             log4perl.filter.M1.LevelToMatch = INFO
135             log4perl.filter.M1.AcceptOnMatch = true
136              
137             =head1 DESCRIPTION
138              
139             Log4perl allows the use of customized filters in its appenders
140             to control the output of messages. These filters might grep for
141             certain text chunks in a message, verify that its priority
142             matches or exceeds a certain level or that this is the 10th
143             time the same message has been submitted -- and come to a log/no log
144             decision based upon these circumstantial facts.
145              
146             Filters have names and can be specified in two different ways in the Log4perl
147             configuration file: As subroutines or as filter classes. Here's a
148             simple filter named C<MyFilter> which just verifies that the
149             oncoming message matches the regular expression C</let this through/i>:
150              
151             log4perl.filter.MyFilter = sub { /let this through/i }
152              
153             It exploits the fact that when the subroutine defined
154             above is called on a message,
155             Perl's special C<$_> variable will be set to the message text (prerendered,
156             i.e. concatenated but not layouted) to be logged.
157             The subroutine is expected to return a true value
158             if it wants the message to be logged or a false value if doesn't.
159              
160             Also, Log::Log4perl will pass a hash to the subroutine,
161             containing all key/value pairs that it would pass to the corresponding
162             appender, as specified in Log::Log4perl::Appender. Here's an
163             example of a filter checking the priority of the oncoming message:
164              
165             log4perl.filter.MyFilter = sub { \
166             my %p = @_; \
167             if($p{log4p_level} eq "WARN" or \
168             $p{log4p_level} eq "INFO") { \
169             return 1; \
170             } \
171             return 0; \
172             }
173              
174             If the message priority equals C<WARN> or C<INFO>,
175             it returns a true value, causing
176             the message to be logged.
177              
178             =head2 Predefined Filters
179              
180             For common tasks like verifying that the message priority matches
181             a certain priority, there's already a
182             set of predefined filters available. To perform an exact level match, it's
183             much cleaner to use Log4perl's C<LevelMatch> filter instead:
184              
185             log4perl.filter.M1 = Log::Log4perl::Filter::LevelMatch
186             log4perl.filter.M1.LevelToMatch = INFO
187             log4perl.filter.M1.AcceptOnMatch = true
188              
189             This will let the message through if its priority is INFO and suppress
190             it otherwise. The statement can be negated by saying
191              
192             log4perl.filter.M1.AcceptOnMatch = false
193              
194             instead. This way, the message will be logged if its priority is
195             anything but INFO.
196              
197             On a similar note, Log4perl's C<StringMatch> filter will check the
198             oncoming message for strings or regular expressions:
199              
200             log4perl.filter.M1 = Log::Log4perl::Filter::StringMatch
201             log4perl.filter.M1.StringToMatch = bl.. bl..
202             log4perl.filter.M1.AcceptOnMatch = true
203              
204             This will open the gate for messages like C<blah blah> because the
205             regular expression in the C<StringToMatch> matches them. Again,
206             the setting of C<AcceptOnMatch> determines if the filter is defined
207             in a positive or negative way.
208              
209             All class filter entries in the configuration file
210             have to adhere to the following rule:
211             Only after a filter has been defined by name and class/subroutine,
212             its attribute values can be
213             assigned, just like the C<true> value above gets assigned to the
214             C<AcceptOnMatch> attribute I<after> the
215             filter C<M1> has been defined.
216              
217             =head2 Attaching a filter to an appender
218              
219             Attaching a filter to an appender is as easy as assigning its name to
220             the appender's C<Filter> attribute:
221              
222             log4perl.appender.MyAppender.Filter = MyFilter
223              
224             This will cause C<Log::Log4perl> to call the filter subroutine/method
225             every time a message is supposed to be passed to the appender. Depending
226             on the filter's return value, C<Log::Log4perl> will either continue as
227             planned or withdraw immediately.
228              
229             =head2 Combining filters with Log::Log4perl::Filter::Boolean
230              
231             Sometimes, it's useful to combine the output of various filters to
232             arrive at a log/no log decision. While Log4j, Log4perl's mother ship,
233             has chosen to implement this feature as a filter chain, similar to Linux' IP chains,
234             Log4perl tries a different approach.
235              
236             Typically, filter results will not need to be bumped along chains but
237             combined in a programmatic manner using boolean logic. "Log if
238             this filter says 'yes' and that filter says 'no'"
239             is a fairly common requirement, but hard to implement as a chain.
240              
241             C<Log::Log4perl::Filter::Boolean> is a specially predefined custom filter
242             for Log4perl. It combines the results of other custom filters
243             in arbitrary ways, using boolean expressions:
244              
245             log4perl.logger = WARN, AppWarn, AppError
246              
247             log4perl.filter.Match1 = sub { /let this through/ }
248             log4perl.filter.Match2 = sub { /and that, too/ }
249             log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean
250             log4perl.filter.MyBoolean.logic = Match1 || Match2
251              
252             log4perl.appender.Screen = Log::Log4perl::Appender::Screen
253             log4perl.appender.Screen.Filter = MyBoolean
254             log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
255              
256             C<Log::Log4perl::Filter::Boolean>'s boolean expressions allow for combining
257             different appenders by name using AND (&& or &), OR (|| or |) and NOT (!) as
258             logical expressions. Also, parentheses can be used for defining precedences.
259             Operator precedence follows standard Perl conventions. Here's a bunch of examples:
260              
261             Match1 && !Match2 # Match1 and not Match2
262             !(Match1 || Match2) # Neither Match1 nor Match2
263             (Match1 && Match2) || Match3 # Both Match1 and Match2 or Match3
264              
265             =head2 Writing your own filter classes
266              
267             If none of Log::Log4perl's predefined filter classes fits your needs,
268             you can easily roll your own: Just define a new class,
269             derive it from the baseclass C<Log::Log4perl::Filter>,
270             and define its C<new> and C<ok> methods like this:
271              
272             package Log::Log4perl::Filter::MyFilter;
273              
274             use base Log::Log4perl::Filter;
275              
276             sub new {
277             my ($class, %options) = @_;
278              
279             my $self = { %options,
280             };
281            
282             bless $self, $class;
283              
284             return $self;
285             }
286              
287             sub ok {
288             my ($self, %p) = @_;
289              
290             # ... decide and return 1 or 0
291             }
292              
293             1;
294              
295             Log4perl will call the ok() method to determine if the filter
296             should let the message pass or not. A true return value indicates
297             the message will be logged by the appender, a false value blocks it.
298              
299             Values you've defined for its attributes in Log4perl's configuration file,
300             will be received through its C<new> method:
301              
302             log4perl.filter.MyFilter = Log::Log4perl::Filter::MyFilter
303             log4perl.filter.MyFilter.color = red
304              
305             will cause C<Log::Log4perl::Filter::MyFilter>'s constructor to be called
306             like this:
307              
308             Log::Log4perl::Filter::MyFilter->new( name => "MyFilter",
309             color => "red" );
310              
311             The custom filter class should use this to set the object's attributes,
312             to have them available later to base log/nolog decisions on it.
313              
314             C<ok()> is the filter's method to tell if it agrees or disagrees with logging
315             the message. It will be called by Log::Log4perl whenever it needs the
316             filter to decide. A false value returned by C<ok()> will block messages,
317             a true value will let them through.
318              
319             =head2 A Practical Example: Level Matching
320              
321             See L<Log::Log4perl::FAQ> for this.
322              
323             =head1 SEE ALSO
324              
325             L<Log::Log4perl::Filter::LevelMatch>,
326             L<Log::Log4perl::Filter::LevelRange>,
327             L<Log::Log4perl::Filter::StringRange>,
328             L<Log::Log4perl::Filter::Boolean>
329              
330             =head1 LICENSE
331              
332             Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
333             and Kevin Goess E<lt>cpan@goess.orgE<gt>.
334              
335             This library is free software; you can redistribute it and/or modify
336             it under the same terms as Perl itself.
337              
338             =head1 AUTHOR
339              
340             Please contribute patches to the project on Github:
341              
342             http://github.com/mschilli/log4perl
343              
344             Send bug reports or requests for enhancements to the authors via our
345              
346             MAILING LIST (questions, bug reports, suggestions/patches):
347             log4perl-devel@lists.sourceforge.net
348              
349             Authors (please contact them via the list above, not directly):
350             Mike Schilli <m@perlmeister.com>,
351             Kevin Goess <cpan@goess.org>
352              
353             Contributors (in alphabetical order):
354             Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
355             Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
356             Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
357             Grundman, Paul Harrington, Alexander Hartmaier David Hull,
358             Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
359             Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
360             Lars Thegler, David Viner, Mac Yang.
361