1##################################################
2package Log::Log4perl::Filter;
3##################################################
4
5use 5.006;
6use strict;
7use warnings;
8
9use Log::Log4perl::Level;
10use Log::Log4perl::Config;
11
12use constant _INTERNAL_DEBUG => 0;
13
14our %FILTERS_DEFINED = ();
15
16##################################################
17sub new {
18##################################################
19    my($class, $name, $action) = @_;
20
21    print "Creating filter $name\n" if _INTERNAL_DEBUG;
22
23    my $self = { name => $name };
24    bless $self, $class;
25
26    if(ref($action) eq "CODE") {
27        # it's a code ref
28        $self->{ok} = $action;
29    } else {
30        # it's something else
31        die "Code for ($name/$action) not properly defined";
32    }
33
34    return $self;
35}
36
37##################################################
38sub register {         # Register a filter by name
39                       # (Passed on to subclasses)
40##################################################
41    my($self) = @_;
42
43    by_name($self->{name}, $self);
44}
45
46##################################################
47sub by_name {        # Get/Set a filter object by name
48##################################################
49    my($name, $value) = @_;
50
51    if(defined $value) {
52        $FILTERS_DEFINED{$name} = $value;
53    }
54
55    if(exists $FILTERS_DEFINED{$name}) {
56        return $FILTERS_DEFINED{$name};
57    } else {
58        return undef;
59    }
60}
61
62##################################################
63sub reset {
64##################################################
65    %FILTERS_DEFINED = ();
66}
67
68##################################################
69sub ok {
70##################################################
71    my($self, %p) = @_;
72
73    print "Calling $self->{name}'s ok method\n" if _INTERNAL_DEBUG;
74
75        # Force filter classes to define their own
76        # ok(). Exempt are only sub {..} ok functions,
77        # defined in the conf file.
78    die "This is to be overridden by the filter" unless
79         defined $self->{ok};
80
81    # What should we set the message in $_ to? The most logical
82    # approach seems to be to concat all parts together. If some
83    # filter wants to dissect the parts, it still can examine %p,
84    # which gets passed to the subroutine and contains the chunks
85    # in $p{message}.
86        # Split because of CVS
87    local($_) = join $
88                     Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}};
89    print "\$_ is '$_'\n" if _INTERNAL_DEBUG;
90
91    my $decision = $self->{ok}->(%p);
92
93    print "$self->{name}'s ok'ed: ",
94          ($decision ? "yes" : "no"), "\n" if _INTERNAL_DEBUG;
95
96    return $decision;
97}
98
991;
100
101__END__
102
103=head1 NAME
104
105Log::Log4perl::Filter - Log4perl Custom Filter Base Class
106
107=head1 SYNOPSIS
108
109  use Log::Log4perl;
110
111  Log::Log4perl->init(\ <<'EOT');
112    log4perl.logger = INFO, Screen
113    log4perl.filter.MyFilter        = sub { /let this through/ }
114    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
115    log4perl.appender.Screen.Filter = MyFilter
116    log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
117  EOT
118
119      # Define a logger
120  my $logger = Log::Log4perl->get_logger("Some");
121
122      # Let this through
123  $logger->info("Here's the info, let this through!");
124
125      # Suppress this
126  $logger->info("Here's the info, suppress this!");
127
128  #################################################################
129  # StringMatch Filter:
130  #################################################################
131  log4perl.filter.M1               = Log::Log4perl::Filter::StringMatch
132  log4perl.filter.M1.StringToMatch = let this through
133  log4perl.filter.M1.AcceptOnMatch = true
134
135  #################################################################
136  # LevelMatch Filter:
137  #################################################################
138  log4perl.filter.M1               = Log::Log4perl::Filter::LevelMatch
139  log4perl.filter.M1.LevelToMatch  = INFO
140  log4perl.filter.M1.AcceptOnMatch = true
141
142=head1 DESCRIPTION
143
144Log4perl allows the use of customized filters in its appenders
145to control the output of messages. These filters might grep for
146certain text chunks in a message, verify that its priority
147matches or exceeds a certain level or that this is the 10th
148time the same message has been submitted -- and come to a log/no log
149decision based upon these circumstantial facts.
150
151Filters have names and can be specified in two different ways in the Log4perl
152configuration file: As subroutines or as filter classes. Here's a
153simple filter named C<MyFilter> which just verifies that the
154oncoming message matches the regular expression C</let this through/i>:
155
156    log4perl.filter.MyFilter        = sub { /let this through/i }
157
158It exploits the fact that when C<ok()> is called on a message,
159Perl's special C<$_> variable will be set to the message text (prerendered,
160i.e. concatenated but not layouted) to be logged.
161The C<ok()> subroutine is expected to return a true value
162if it wants the message to be logged or a false value if doesn't.
163
164Also, Log::Log4perl will pass a hash to the C<ok()> method,
165containing all key/value pairs that it would pass to the corresponding
166appender, as specified in Log::Log4perl::Appender. Here's an
167example of a filter checking the priority of the oncoming message:
168
169  log4perl.filter.MyFilter        = sub {    \
170       my %p = @_;                           \
171       $p{log4p_level} eq "WARN" or          \
172       $p{log4p_level} eq "INFO"             \
173                                          }
174
175If the message priority equals C<WARN> or C<INFO>,
176it returns a true value, causing
177the message to be logged.
178
179=head2 Predefined Filters
180
181For common tasks like verifying that the message priority matches
182a certain priority, there's already a
183set of predefined filters available. To perform an exact level match, it's
184much cleaner to use Log4perl's C<LevelMatch> filter instead:
185
186  log4perl.filter.M1               = Log::Log4perl::Filter::LevelMatch
187  log4perl.filter.M1.LevelToMatch  = INFO
188  log4perl.filter.M1.AcceptOnMatch = true
189
190This will let the message through if its priority is INFO and suppress
191it otherwise. The statement can be negated by saying
192
193  log4perl.filter.M1.AcceptOnMatch = false
194
195instead. This way, the message will be logged if its priority is
196anything but INFO.
197
198On a similar note, Log4perl's C<StringMatch> filter will check the
199oncoming message for strings or regular expressions:
200
201  log4perl.filter.M1               = Log::Log4perl::Filter::StringMatch
202  log4perl.filter.M1.StringToMatch = bl.. bl..
203  log4perl.filter.M1.AcceptOnMatch = true
204
205This will open the gate for messages like C<blah blah> because the
206regular expression in the C<StringToMatch> matches them. Again,
207the setting of C<AcceptOnMatch> determines if the filter is defined
208in a positive or negative way.
209
210All class filter entries in the configuration file
211have to adhere to the following rule:
212Only after a filter has been defined by name and class/subroutine,
213its attribute values can be
214assigned, just like the C<true> value above gets assigned to the
215C<AcceptOnMatch> attribute I<after> the
216filter C<M1> has been defined.
217
218=head2 Attaching a filter to an appender
219
220Attaching a filter to an appender is as easy as assigning its name to
221the appender's C<Filter> attribute:
222
223    log4perl.appender.MyAppender.Filter = MyFilter
224
225This will cause C<Log::Log4perl> to call the filter subroutine/method
226every time a message is supposed to be passed to the appender. Depending
227on the filter's return value, C<Log::Log4perl> will either continue as
228planned or withdraw immediately.
229
230=head2 Combining filters with Log::Log4perl::Filter::Boolean
231
232Sometimes, it's useful to combine the output of various filters to
233arrive at a log/no log decision. While Log4j, Log4perl's mother ship,
234has chosen to implement this feature as a filter chain, similar to Linux' IP chains,
235Log4perl tries a different approach.
236
237Typically, filter results will not need to be bumped along chains but
238combined in a programmatic manner using boolean logic. "Log if
239this filter says 'yes' and that filter says 'no'"
240is a fairly common requirement, but hard to implement as a chain.
241
242C<Log::Log4perl::Filter::Boolean> is a specially predefined custom filter
243for Log4perl. It combines the results of other custom filters
244in arbitrary ways, using boolean expressions:
245
246    log4perl.logger = WARN, AppWarn, AppError
247
248    log4perl.filter.Match1       = sub { /let this through/ }
249    log4perl.filter.Match2       = sub { /and that, too/ }
250    log4perl.filter.MyBoolean       = Log::Log4perl::Filter::Boolean
251    log4perl.filter.MyBoolean.logic = Match1 || Match2
252
253    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
254    log4perl.appender.Screen.Filter = MyBoolean
255    log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
256
257C<Log::Log4perl::Filter::Boolean>'s boolean expressions allow for combining
258different appenders by name using AND (&& or &), OR (|| or |) and NOT (!) as
259logical expressions. Also, parentheses can be used for defining precedences.
260Operator precedence follows standard Perl conventions. Here's a bunch of examples:
261
262    Match1 && !Match2            # Match1 and not Match2
263    !(Match1 || Match2)          # Neither Match1 nor Match2
264    (Match1 && Match2) || Match3 # Both Match1 and Match2 or Match3
265
266=head2 Writing your own filter classes
267
268If none of Log::Log4perl's predefined filter classes fits your needs,
269you can easily roll your own: Just define a new class,
270derive it from the baseclass C<Log::Log4perl::Filter>,
271and define its C<new> and C<ok> methods like this:
272
273    package Log::Log4perl::Filter::MyFilter;
274
275    use base Log::Log4perl::Filter;
276
277    sub new {
278        my ($class, %options) = @_;
279
280        my $self = { %options,
281                   };
282
283        bless $self, $class;
284
285        return $self;
286    }
287
288    sub ok {
289         my ($self, %p) = @_;
290
291         # ... decide and return 1 or 0
292    }
293
294    1;
295
296Values you've defined for its attributes in Log4perl's configuration file,
297will be received through its C<new> method:
298
299    log4perl.filter.MyFilter       = Log::Log4perl::Filter::MyFilter
300    log4perl.filter.MyFilter.color = red
301
302will cause C<Log::Log4perl::Filter::MyFilter>'s constructor to be called
303like this:
304
305    Log::Log4perl::Filter::MyFilter->new( name  => "MyFilter",
306                                          color => "red" );
307
308The custom filter class should use this to set the object's attributes,
309to have them available later to base log/nolog decisions on it.
310
311C<ok()> is the filter's method to tell if it agrees or disagrees with logging
312the message. It will be called by Log::Log4perl whenever it needs the
313filter to decide. A false value returned by C<ok()> will block messages,
314a true value will let them through.
315
316=head2 A Practical Example: Level Matching
317
318See L<Log::Log4perl::FAQ> for this.
319
320=head1 SEE ALSO
321
322L<Log::Log4perl::Filter::LevelMatch>,
323L<Log::Log4perl::Filter::LevelRange>,
324L<Log::Log4perl::Filter::StringRange>,
325L<Log::Log4perl::Filter::Boolean>
326
327=head1 AUTHOR
328
329Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003
330
331=cut
332