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