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 the subroutine defined 159above is called on a message, 160Perl's special C<$_> variable will be set to the message text (prerendered, 161i.e. concatenated but not layouted) to be logged. 162The subroutine is expected to return a true value 163if it wants the message to be logged or a false value if doesn't. 164 165Also, Log::Log4perl will pass a hash to the subroutine, 166containing all key/value pairs that it would pass to the corresponding 167appender, as specified in Log::Log4perl::Appender. Here's an 168example of a filter checking the priority of the oncoming message: 169 170 log4perl.filter.MyFilter = sub { \ 171 my %p = @_; \ 172 if($p{log4p_level} eq "WARN" or \ 173 $p{log4p_level} eq "INFO") { \ 174 return 1; \ 175 } \ 176 return 0; \ 177 } 178 179If the message priority equals C<WARN> or C<INFO>, 180it returns a true value, causing 181the message to be logged. 182 183=head2 Predefined Filters 184 185For common tasks like verifying that the message priority matches 186a certain priority, there's already a 187set of predefined filters available. To perform an exact level match, it's 188much cleaner to use Log4perl's C<LevelMatch> filter instead: 189 190 log4perl.filter.M1 = Log::Log4perl::Filter::LevelMatch 191 log4perl.filter.M1.LevelToMatch = INFO 192 log4perl.filter.M1.AcceptOnMatch = true 193 194This will let the message through if its priority is INFO and suppress 195it otherwise. The statement can be negated by saying 196 197 log4perl.filter.M1.AcceptOnMatch = false 198 199instead. This way, the message will be logged if its priority is 200anything but INFO. 201 202On a similar note, Log4perl's C<StringMatch> filter will check the 203oncoming message for strings or regular expressions: 204 205 log4perl.filter.M1 = Log::Log4perl::Filter::StringMatch 206 log4perl.filter.M1.StringToMatch = bl.. bl.. 207 log4perl.filter.M1.AcceptOnMatch = true 208 209This will open the gate for messages like C<blah blah> because the 210regular expression in the C<StringToMatch> matches them. Again, 211the setting of C<AcceptOnMatch> determines if the filter is defined 212in a positive or negative way. 213 214All class filter entries in the configuration file 215have to adhere to the following rule: 216Only after a filter has been defined by name and class/subroutine, 217its attribute values can be 218assigned, just like the C<true> value above gets assigned to the 219C<AcceptOnMatch> attribute I<after> the 220filter C<M1> has been defined. 221 222=head2 Attaching a filter to an appender 223 224Attaching a filter to an appender is as easy as assigning its name to 225the appender's C<Filter> attribute: 226 227 log4perl.appender.MyAppender.Filter = MyFilter 228 229This will cause C<Log::Log4perl> to call the filter subroutine/method 230every time a message is supposed to be passed to the appender. Depending 231on the filter's return value, C<Log::Log4perl> will either continue as 232planned or withdraw immediately. 233 234=head2 Combining filters with Log::Log4perl::Filter::Boolean 235 236Sometimes, it's useful to combine the output of various filters to 237arrive at a log/no log decision. While Log4j, Log4perl's mother ship, 238has chosen to implement this feature as a filter chain, similar to Linux' IP chains, 239Log4perl tries a different approach. 240 241Typically, filter results will not need to be bumped along chains but 242combined in a programmatic manner using boolean logic. "Log if 243this filter says 'yes' and that filter says 'no'" 244is a fairly common requirement, but hard to implement as a chain. 245 246C<Log::Log4perl::Filter::Boolean> is a specially predefined custom filter 247for Log4perl. It combines the results of other custom filters 248in arbitrary ways, using boolean expressions: 249 250 log4perl.logger = WARN, AppWarn, AppError 251 252 log4perl.filter.Match1 = sub { /let this through/ } 253 log4perl.filter.Match2 = sub { /and that, too/ } 254 log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean 255 log4perl.filter.MyBoolean.logic = Match1 || Match2 256 257 log4perl.appender.Screen = Log::Log4perl::Appender::Screen 258 log4perl.appender.Screen.Filter = MyBoolean 259 log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout 260 261C<Log::Log4perl::Filter::Boolean>'s boolean expressions allow for combining 262different appenders by name using AND (&& or &), OR (|| or |) and NOT (!) as 263logical expressions. Also, parentheses can be used for defining precedences. 264Operator precedence follows standard Perl conventions. Here's a bunch of examples: 265 266 Match1 && !Match2 # Match1 and not Match2 267 !(Match1 || Match2) # Neither Match1 nor Match2 268 (Match1 && Match2) || Match3 # Both Match1 and Match2 or Match3 269 270=head2 Writing your own filter classes 271 272If none of Log::Log4perl's predefined filter classes fits your needs, 273you can easily roll your own: Just define a new class, 274derive it from the baseclass C<Log::Log4perl::Filter>, 275and define its C<new> and C<ok> methods like this: 276 277 package Log::Log4perl::Filter::MyFilter; 278 279 use base Log::Log4perl::Filter; 280 281 sub new { 282 my ($class, %options) = @_; 283 284 my $self = { %options, 285 }; 286 287 bless $self, $class; 288 289 return $self; 290 } 291 292 sub ok { 293 my ($self, %p) = @_; 294 295 # ... decide and return 1 or 0 296 } 297 298 1; 299 300Log4perl will call the ok() method to determine if the filter 301should let the message pass or not. A true return value indicates 302the message will be logged by the appender, a false value blocks it. 303 304Values you've defined for its attributes in Log4perl's configuration file, 305will be received through its C<new> method: 306 307 log4perl.filter.MyFilter = Log::Log4perl::Filter::MyFilter 308 log4perl.filter.MyFilter.color = red 309 310will cause C<Log::Log4perl::Filter::MyFilter>'s constructor to be called 311like this: 312 313 Log::Log4perl::Filter::MyFilter->new( name => "MyFilter", 314 color => "red" ); 315 316The custom filter class should use this to set the object's attributes, 317to have them available later to base log/nolog decisions on it. 318 319C<ok()> is the filter's method to tell if it agrees or disagrees with logging 320the message. It will be called by Log::Log4perl whenever it needs the 321filter to decide. A false value returned by C<ok()> will block messages, 322a true value will let them through. 323 324=head2 A Practical Example: Level Matching 325 326See L<Log::Log4perl::FAQ> for this. 327 328=head1 SEE ALSO 329 330L<Log::Log4perl::Filter::LevelMatch>, 331L<Log::Log4perl::Filter::LevelRange>, 332L<Log::Log4perl::Filter::StringRange>, 333L<Log::Log4perl::Filter::Boolean> 334 335=head1 LICENSE 336 337Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 338and Kevin Goess E<lt>cpan@goess.orgE<gt>. 339 340This library is free software; you can redistribute it and/or modify 341it under the same terms as Perl itself. 342 343=head1 AUTHOR 344 345Please contribute patches to the project on Github: 346 347 http://github.com/mschilli/log4perl 348 349Send bug reports or requests for enhancements to the authors via our 350 351MAILING LIST (questions, bug reports, suggestions/patches): 352log4perl-devel@lists.sourceforge.net 353 354Authors (please contact them via the list above, not directly): 355Mike Schilli <m@perlmeister.com>, 356Kevin Goess <cpan@goess.org> 357 358Contributors (in alphabetical order): 359Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 360Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 361Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 362Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 363Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 364Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 365 366