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