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