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 AUTHOR
175
176Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003
177
178=cut
179