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