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