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