File Coverage

blib/lib/Log/Log4perl/Filter/LevelRange.pm
Criterion Covered Total %
statement 33 33 100.0
branch 2 2 100.0
condition 3 3 100.0
subroutine 10 10 100.0
pod 0 2 0.0
total 48 50 96.0


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