1################################################## 2package Log::Log4perl::Filter::StringMatch; 3################################################## 4 5use 5.006; 6 7use strict; 8use warnings; 9 10use Log::Log4perl::Config; 11 12use constant _INTERNAL_DEBUG => 0; 13 14use base "Log::Log4perl::Filter"; 15 16################################################## 17sub new { 18################################################## 19 my ($class, %options) = @_; 20 21 print join('-', %options) if _INTERNAL_DEBUG; 22 23 my $self = { StringToMatch => '', 24 AcceptOnMatch => 1, 25 %options, 26 }; 27 28 $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish( 29 $self->{AcceptOnMatch}); 30 31 $self->{StringToMatch} = qr($self->{StringToMatch}); 32 33 bless $self, $class; 34 35 return $self; 36} 37 38################################################## 39sub ok { 40################################################## 41 my ($self, %p) = @_; 42 43 local($_) = join $ 44 Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}}; 45 46 if($_ =~ $self->{StringToMatch}) { 47 print "Strings match\n" if _INTERNAL_DEBUG; 48 return $self->{AcceptOnMatch}; 49 } else { 50 print "Strings don't match ($_/$self->{StringToMatch})\n" 51 if _INTERNAL_DEBUG; 52 return !$self->{AcceptOnMatch}; 53 } 54} 55 561; 57 58__END__ 59 60=head1 NAME 61 62Log::Log4perl::Filter::StringMatch - Filter to match the log level exactly 63 64=head1 SYNOPSIS 65 66 log4perl.filter.Match1 = Log::Log4perl::Filter::StringMatch 67 log4perl.filter.Match1.StringToMatch = blah blah 68 log4perl.filter.Match1.AcceptOnMatch = true 69 70=head1 DESCRIPTION 71 72This Log4perl custom filter checks if the currently submitted message 73matches a predefined regular expression, as set in the C<StringToMatch> 74parameter. It uses common Perl 5 regexes. 75 76The additional parameter C<AcceptOnMatch> defines if the filter 77is supposed to pass or block the message on a match (C<true> or C<false>). 78 79=head1 SEE ALSO 80 81L<Log::Log4perl::Filter>, 82L<Log::Log4perl::Filter::LevelMatch>, 83L<Log::Log4perl::Filter::LevelRange>, 84L<Log::Log4perl::Filter::Boolean> 85 86=head1 AUTHOR 87 88Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003 89 90=cut 91