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;
12
13use constant _INTERNAL_DEBUG => 0;
14
15use base qw(Log::Log4perl::Filter);
16
17##################################################
18sub new {
19##################################################
20    my ($class, %options) = @_;
21
22    my $self = { LevelToMatch  => '',
23                 AcceptOnMatch => 1,
24                 %options,
25               };
26
27    $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish(
28                                                $self->{AcceptOnMatch});
29
30    bless $self, $class;
31
32    return $self;
33}
34
35##################################################
36sub ok {
37##################################################
38     my ($self, %p) = @_;
39
40     if($self->{LevelToMatch} eq $p{log4p_level}) {
41         print "Levels match\n" if _INTERNAL_DEBUG;
42         return $self->{AcceptOnMatch};
43     } else {
44         print "Levels don't match\n" if _INTERNAL_DEBUG;
45         return !$self->{AcceptOnMatch};
46     }
47}
48
491;
50
51__END__
52
53=head1 NAME
54
55Log::Log4perl::Filter::LevelMatch - Filter to match the log level exactly
56
57=head1 SYNOPSIS
58
59    log4perl.filter.Match1               = Log::Log4perl::Filter::LevelMatch
60    log4perl.filter.Match1.LevelToMatch  = ERROR
61    log4perl.filter.Match1.AcceptOnMatch = true
62
63=head1 DESCRIPTION
64
65This Log4perl custom filter checks if the currently submitted message
66matches a predefined priority, as set in C<LevelToMatch>.
67The additional parameter C<AcceptOnMatch> defines if the filter
68is supposed to pass or block the message (C<true> or C<false>)
69on a match.
70
71=head1 SEE ALSO
72
73L<Log::Log4perl::Filter>,
74L<Log::Log4perl::Filter::LevelRange>,
75L<Log::Log4perl::Filter::StringRange>,
76L<Log::Log4perl::Filter::Boolean>
77
78=head1 AUTHOR
79
80Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003
81
82=cut
83