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