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