File Coverage

blib/lib/Log/Log4perl/Filter/LevelMatch.pm
Criterion Covered Total %
statement 29 29 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 38 39 97.4


line stmt bran cond sub pod time code
1             ##################################################
2             ##################################################
3              
4             use 5.006;
5 1     1   18  
  1         4  
6             use strict;
7 1     1   6 use warnings;
  1         2  
  1         34  
8 1     1   6  
  1         2  
  1         28  
9             use Log::Log4perl::Level;
10 1     1   6 use Log::Log4perl::Config;
  1         2  
  1         7  
11 1     1   6 use Log::Log4perl::Util qw( params_check );
  1         2  
  1         36  
12 1     1   6  
  1         1  
  1         48  
13             use constant _INTERNAL_DEBUG => 0;
14 1     1   5  
  1         3  
  1         70  
15             use base qw(Log::Log4perl::Filter);
16 1     1   7  
  1         2  
  1         311  
17             ##################################################
18             ##################################################
19             my ($class, %options) = @_;
20              
21 7     7 0 28 my $self = { LevelToMatch => '',
22             AcceptOnMatch => 1,
23 7         33 %options,
24             };
25            
26             params_check( $self,
27             [ qw( LevelToMatch ) ],
28 7         36 [ qw( name AcceptOnMatch ) ]
29             );
30              
31             $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish(
32             $self->{AcceptOnMatch});
33              
34 6         20 bless $self, $class;
35              
36 6         14 return $self;
37             }
38 6         17  
39             ##################################################
40             ##################################################
41             my ($self, %p) = @_;
42              
43             if($self->{LevelToMatch} eq $p{log4p_level}) {
44             print "Levels match\n" if _INTERNAL_DEBUG;
45             return $self->{AcceptOnMatch};
46             } else {
47             print "Levels don't match\n" if _INTERNAL_DEBUG;
48             return !$self->{AcceptOnMatch};
49             }
50             }
51              
52             1;
53              
54              
55             =encoding utf8
56              
57             =head1 NAME
58              
59             Log::Log4perl::Filter::LevelMatch - Filter to match the log level exactly
60              
61             =head1 SYNOPSIS
62              
63             log4perl.filter.Match1 = Log::Log4perl::Filter::LevelMatch
64             log4perl.filter.Match1.LevelToMatch = ERROR
65             log4perl.filter.Match1.AcceptOnMatch = true
66              
67             =head1 DESCRIPTION
68              
69             This Log4perl custom filter checks if the currently submitted message
70             matches a predefined priority, as set in C<LevelToMatch>.
71             The additional parameter C<AcceptOnMatch> defines if the filter
72             is supposed to pass or block the message (C<true> or C<false>)
73             on a match.
74              
75             =head1 SEE ALSO
76              
77             L<Log::Log4perl::Filter>,
78             L<Log::Log4perl::Filter::Boolean>,
79             L<Log::Log4perl::Filter::LevelRange>,
80             L<Log::Log4perl::Filter::MDC>,
81             L<Log::Log4perl::Filter::StringMatch>
82              
83             =head1 LICENSE
84              
85             Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
86             and Kevin Goess E<lt>cpan@goess.orgE<gt>.
87              
88             This library is free software; you can redistribute it and/or modify
89             it under the same terms as Perl itself.
90              
91             =head1 AUTHOR
92              
93             Please contribute patches to the project on Github:
94              
95             http://github.com/mschilli/log4perl
96              
97             Send bug reports or requests for enhancements to the authors via our
98              
99             MAILING LIST (questions, bug reports, suggestions/patches):
100             log4perl-devel@lists.sourceforge.net
101              
102             Authors (please contact them via the list above, not directly):
103             Mike Schilli <m@perlmeister.com>,
104             Kevin Goess <cpan@goess.org>
105              
106             Contributors (in alphabetical order):
107             Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
108             Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
109             Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
110             Grundman, Paul Harrington, Alexander Hartmaier David Hull,
111             Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
112             Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
113             Lars Thegler, David Viner, Mac Yang.
114