##################################################
package Log::Log4perl::Filter;
##################################################

use 5.006;
use strict;
use warnings;

use Log::Log4perl::Level;
use Log::Log4perl::Config;

use constant _INTERNAL_DEBUG => 0;

our %FILTERS_DEFINED = ();

##################################################
sub new {
##################################################
    my($class, $name, $action) = @_;
  
    print "Creating filter $name\n" if _INTERNAL_DEBUG;

    my $self = { name => $name };
    bless $self, $class;

    if(ref($action) eq "CODE") {
        # it's a code ref
        $self->{ok} = $action;
    } else {
        # it's something else
        die "Code for ($name/$action) not properly defined";
    }

    return $self;
}

##################################################
sub register {         # Register a filter by name
                       # (Passed on to subclasses)
##################################################
    my($self) = @_;

    by_name($self->{name}, $self);
}

##################################################
sub by_name {        # Get/Set a filter object by name
##################################################
    my($name, $value) = @_;

    if(defined $value) {
        $FILTERS_DEFINED{$name} = $value;
    }

    if(exists $FILTERS_DEFINED{$name}) {
        return $FILTERS_DEFINED{$name};
    } else {
        return undef;
    }
}

##################################################
sub reset {
##################################################
    %FILTERS_DEFINED = ();
}

##################################################
sub ok {
##################################################
    my($self, %p) = @_;

    print "Calling $self->{name}'s ok method\n" if _INTERNAL_DEBUG;

        # Force filter classes to define their own
        # ok(). Exempt are only sub {..} ok functions,
        # defined in the conf file.
    die "This is to be overridden by the filter" unless
         defined $self->{ok};

    # What should we set the message in $_ to? The most logical
    # approach seems to be to concat all parts together. If some
    # filter wants to dissect the parts, it still can examine %p,
    # which gets passed to the subroutine and contains the chunks
    # in $p{message}.
        # Split because of CVS
    local($_) = join $
                     Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}};
    print "\$_ is '$_'\n" if _INTERNAL_DEBUG;

    my $decision = $self->{ok}->(%p);

    print "$self->{name}'s ok'ed: ", 
          ($decision ? "yes" : "no"), "\n" if _INTERNAL_DEBUG;

    return $decision;
}

1;

__END__

=head1 NAME

Log::Log4perl::Filter - Log4perl Custom Filter Base Class

=head1 SYNOPSIS

  use Log::Log4perl;

  Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, Screen
    log4perl.filter.MyFilter        = sub { /let this through/ }
    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
    log4perl.appender.Screen.Filter = MyFilter
    log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
  EOT

      # Define a logger
  my $logger = Log::Log4perl->get_logger("Some");

      # Let this through
  $logger->info("Here's the info, let this through!");

      # Suppress this
  $logger->info("Here's the info, suppress this!");

  #################################################################
  # StringMatch Filter:
  #################################################################
  log4perl.filter.M1               = Log::Log4perl::Filter::StringMatch
  log4perl.filter.M1.StringToMatch = let this through
  log4perl.filter.M1.AcceptOnMatch = true

  #################################################################
  # LevelMatch Filter:
  #################################################################
  log4perl.filter.M1               = Log::Log4perl::Filter::LevelMatch
  log4perl.filter.M1.LevelToMatch  = INFO
  log4perl.filter.M1.AcceptOnMatch = true

=head1 DESCRIPTION

Log4perl allows the use of customized filters in its appenders
to control the output of messages. These filters might grep for
certain text chunks in a message, verify that its priority
matches or exceeds a certain level or that this is the 10th
time the same message has been submitted -- and come to a log/no log 
decision based upon these circumstantial facts.

Filters have names and can be specified in two different ways in the Log4perl
configuration file: As subroutines or as filter classes. Here's a 
simple filter named C<MyFilter> which just verifies that the 
oncoming message matches the regular expression C</let this through/i>:

    log4perl.filter.MyFilter        = sub { /let this through/i }

It exploits the fact that when C<ok()> is called on a message,
Perl's special C<$_> variable will be set to the message text (prerendered,
i.e. concatenated but not layouted) to be logged. 
The C<ok()> subroutine is expected to return a true value 
if it wants the message to be logged or a false value if doesn't.

Also, Log::Log4perl will pass a hash to the C<ok()> method,
containing all key/value pairs that it would pass to the corresponding 
appender, as specified in Log::Log4perl::Appender. Here's an
example of a filter checking the priority of the oncoming message:

  log4perl.filter.MyFilter        = sub {    \
       my %p = @_;                           \
       $p{log4p_level} eq "WARN" or          \
       $p{log4p_level} eq "INFO"             \
                                          }

If the message priority equals C<WARN> or C<INFO>, 
it returns a true value, causing
the message to be logged.

=head2 Predefined Filters

For common tasks like verifying that the message priority matches
a certain priority, there's already a 
set of predefined filters available. To perform an exact level match, it's
much cleaner to use Log4perl's C<LevelMatch> filter instead:

  log4perl.filter.M1               = Log::Log4perl::Filter::LevelMatch
  log4perl.filter.M1.LevelToMatch  = INFO
  log4perl.filter.M1.AcceptOnMatch = true

This will let the message through if its priority is INFO and suppress
it otherwise. The statement can be negated by saying

  log4perl.filter.M1.AcceptOnMatch = false

instead. This way, the message will be logged if its priority is
anything but INFO.

On a similar note, Log4perl's C<StringMatch> filter will check the 
oncoming message for strings or regular expressions:

  log4perl.filter.M1               = Log::Log4perl::Filter::StringMatch
  log4perl.filter.M1.StringToMatch = bl.. bl..
  log4perl.filter.M1.AcceptOnMatch = true

This will open the gate for messages like C<blah blah> because the 
regular expression in the C<StringToMatch> matches them. Again,
the setting of C<AcceptOnMatch> determines if the filter is defined
in a positive or negative way.

All class filter entries in the configuration file
have to adhere to the following rule:
Only after a filter has been defined by name and class/subroutine,
its attribute values can be
assigned, just like the C<true> value above gets assigned to the
C<AcceptOnMatch> attribute I<after> the
filter C<M1> has been defined.

=head2 Attaching a filter to an appender

Attaching a filter to an appender is as easy as assigning its name to
the appender's C<Filter> attribute:

    log4perl.appender.MyAppender.Filter = MyFilter

This will cause C<Log::Log4perl> to call the filter subroutine/method
every time a message is supposed to be passed to the appender. Depending
on the filter's return value, C<Log::Log4perl> will either continue as
planned or withdraw immediately.

=head2 Combining filters with Log::Log4perl::Filter::Boolean

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,
has chosen 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 bumped along 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 specially predefined custom filter
for Log4perl. It 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::Log4perl::Appender::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. Also, parentheses can be used for defining precedences. 
Operator precedence follows standard Perl conventions. 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

=head2 Writing your own filter classes

If none of Log::Log4perl's predefined filter classes fits your needs,
you can easily roll your own: Just define a new class,
derive it from the baseclass C<Log::Log4perl::Filter>,
and define its C<new> and C<ok> methods like this:

    package Log::Log4perl::Filter::MyFilter;

    use base Log::Log4perl::Filter;

    sub new {
        my ($class, %options) = @_;

        my $self = { %options,
                   };
     
        bless $self, $class;

        return $self;
    }

    sub ok {
         my ($self, %p) = @_;

         # ... decide and return 1 or 0
    }

    1;

Values you've defined for its attributes in Log4perl's configuration file,
will be received through its C<new> method:

    log4perl.filter.MyFilter       = Log::Log4perl::Filter::MyFilter
    log4perl.filter.MyFilter.color = red

will cause C<Log::Log4perl::Filter::MyFilter>'s constructor to be called
like this:

    Log::Log4perl::Filter::MyFilter->new( name  => "MyFilter",
                                          color => "red" );

The custom filter class should use this to set the object's attributes, 
to have them available later to base log/nolog decisions on it.

C<ok()> is the filter's method to tell if it agrees or disagrees with logging
the message. It will be called by Log::Log4perl whenever it needs the
filter to decide. A false value returned by C<ok()> will block messages,
a true value will let them through.

=head2 A Practical Example: Level Matching

See L<Log::Log4perl::FAQ> for this.

=head1 SEE ALSO

L<Log::Log4perl::Filter::LevelMatch>,
L<Log::Log4perl::Filter::LevelRange>,
L<Log::Log4perl::Filter::StringRange>,
L<Log::Log4perl::Filter::Boolean>

=head1 AUTHOR

Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003

=cut