/usr/share/perl5/Log/Log4perl/Filter/Boolean.pm is in liblog-log4perl-perl 1.44-1ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | ##################################################
package Log::Log4perl::Filter::Boolean;
##################################################
use 5.006;
use strict;
use warnings;
use Log::Log4perl::Level;
use Log::Log4perl::Config;
use constant _INTERNAL_DEBUG => 0;
use base qw(Log::Log4perl::Filter);
##################################################
sub new {
##################################################
my ($class, %options) = @_;
my $self = { params => {},
%options,
};
bless $self, $class;
print "Compiling '$options{logic}'\n" if _INTERNAL_DEBUG;
# Set up meta-decider for later
$self->compile_logic($options{logic});
return $self;
}
##################################################
sub ok {
##################################################
my ($self, %p) = @_;
return $self->eval_logic(\%p);
}
##################################################
sub compile_logic {
##################################################
my ($self, $logic) = @_;
# Extract Filter placeholders in logic as defined
# in configuration file.
while($logic =~ /([\w_-]+)/g) {
# Get the corresponding filter object
my $filter = Log::Log4perl::Filter::by_name($1);
die "Filter $filter required by Boolean filter, but not defined"
unless $filter;
$self->{params}->{$1} = $filter;
}
# Fabricate a parameter list: A1/A2/A3 => $A1, $A2, $A3
my $plist = join ', ', map { '$' . $_ } keys %{$self->{params}};
# Replace all the (dollar-less) placeholders in the code
# by scalars (basically just put dollars in front of them)
$logic =~ s/([\w_-]+)/\$$1/g;
# Set up the meta decider, which transforms the config file
# logic into compiled perl code
my $func = <<EOT;
sub {
my($plist) = \@_;
$logic;
}
EOT
print "func=$func\n" if _INTERNAL_DEBUG;
my $eval_func = eval $func;
if(! $eval_func) {
die "Syntax error in Boolean filter logic: $eval_func";
}
$self->{eval_func} = $eval_func;
}
##################################################
sub eval_logic {
##################################################
my($self, $p) = @_;
my @plist = ();
# Eval the results of all filters referenced
# in the code (although the order of keys is
# not predictable, it is consistent :)
for my $param (keys %{$self->{params}}) {
# Call ok() and map the result to 1 or 0
print "Calling filter $param\n" if _INTERNAL_DEBUG;
push @plist, ($self->{params}->{$param}->ok(%$p) ? 1 : 0);
}
# Now pipe the parameters into the canned function,
# have it evaluate the logic and return the final
# decision
print "Passing in (", join(', ', @plist), ")\n" if _INTERNAL_DEBUG;
return $self->{eval_func}->(@plist);
}
1;
__END__
=encoding utf8
=head1 NAME
Log::Log4perl::Filter::Boolean - Special filter to combine the results of others
=head1 SYNOPSIS
log4perl.logger = WARN, AppWarn, AppError
log4perl.filter.Match1 = sub { /let this through/ }
log4perl.filter.Match2 = sub { /and that, too/ }
log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean.logic = Match1 || Match2
log4perl.appender.Screen = Log::Dispatch::Screen
log4perl.appender.Screen.Filter = MyBoolean
log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
=head1 DESCRIPTION
Sometimes, it's useful to combine the output of various filters to
arrive at a log/no log decision. While Log4j, Log4perl's mother ship,
chose to implement this feature as a filter chain, similar to Linux' IP chains,
Log4perl tries a different approach.
Typically, filter results will not need to be passed along in chains but
combined in a programmatic manner using boolean logic. "Log if
this filter says 'yes' and that filter says 'no'"
is a fairly common requirement but hard to implement as a chain.
C<Log::Log4perl::Filter::Boolean> is a special predefined custom filter
for Log4perl which combines the results of other custom filters
in arbitrary ways, using boolean expressions:
log4perl.logger = WARN, AppWarn, AppError
log4perl.filter.Match1 = sub { /let this through/ }
log4perl.filter.Match2 = sub { /and that, too/ }
log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean.logic = Match1 || Match2
log4perl.appender.Screen = Log::Dispatch::Screen
log4perl.appender.Screen.Filter = MyBoolean
log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
C<Log::Log4perl::Filter::Boolean>'s boolean expressions allow for combining
different appenders by name using AND (&& or &), OR (|| or |) and NOT (!) as
logical expressions. Parentheses are used for grouping. Precedence follows
standard Perl. Here's a bunch of examples:
Match1 && !Match2 # Match1 and not Match2
!(Match1 || Match2) # Neither Match1 nor Match2
(Match1 && Match2) || Match3 # Both Match1 and Match2 or Match3
=head1 SEE ALSO
L<Log::Log4perl::Filter>,
L<Log::Log4perl::Filter::LevelMatch>,
L<Log::Log4perl::Filter::LevelRange>,
L<Log::Log4perl::Filter::MDC>,
L<Log::Log4perl::Filter::StringRange>
=head1 LICENSE
Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
and Kevin Goess E<lt>cpan@goess.orgE<gt>.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Please contribute patches to the project on Github:
http://github.com/mschilli/log4perl
Send bug reports or requests for enhancements to the authors via our
MAILING LIST (questions, bug reports, suggestions/patches):
log4perl-devel@lists.sourceforge.net
Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>
Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier David Hull,
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
Lars Thegler, David Viner, Mac Yang.
|