home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / LevelMatch.pm < prev    next >
Encoding:
Perl POD Document  |  2003-03-14  |  1.9 KB  |  83 lines
  1. ##################################################
  2. package Log::Log4perl::Filter::LevelMatch;
  3. ##################################################
  4.  
  5. use 5.006;
  6.  
  7. use strict;
  8. use warnings;
  9.  
  10. use Log::Log4perl::Level;
  11. use Log::Log4perl::Config;
  12.  
  13. use constant DEBUG => 0;
  14.  
  15. use base qw(Log::Log4perl::Filter);
  16.  
  17. ##################################################
  18. sub new {
  19. ##################################################
  20.     my ($class, %options) = @_;
  21.  
  22.     my $self = { LevelToMatch  => '',
  23.                  AcceptOnMatch => 1,
  24.                  %options,
  25.                };
  26.      
  27.     $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish(
  28.                                                 $self->{AcceptOnMatch});
  29.  
  30.     bless $self, $class;
  31.  
  32.     return $self;
  33. }
  34.  
  35. ##################################################
  36. sub ok {
  37. ##################################################
  38.      my ($self, %p) = @_;
  39.  
  40.      if($self->{LevelToMatch} eq $p{log4p_level}) {
  41.          print "Levels match\n" if DEBUG;
  42.          return $self->{AcceptOnMatch};
  43.      } else {
  44.          print "Levels don't match\n" if DEBUG;
  45.          return !$self->{AcceptOnMatch};
  46.      }
  47. }
  48.  
  49. 1;
  50.  
  51. __END__
  52.  
  53. =head1 NAME
  54.  
  55. Log::Log4perl::Filter::LevelMatch - Filter to match the log level exactly
  56.  
  57. =head1 SYNOPSIS
  58.  
  59.     log4perl.filter.Match1               = Log::Log4perl::Filter::LevelMatch
  60.     log4perl.filter.Match1.LevelToMatch  = ERROR
  61.     log4perl.filter.Match1.AcceptOnMatch = true
  62.  
  63. =head1 DESCRIPTION
  64.  
  65. This Log4perl custom filter checks if the currently submitted message
  66. matches a predefined priority, as set in C<LevelToMatch>.
  67. The additional parameter C<AcceptOnMatch> defines if the filter
  68. is supposed to pass or block the message (C<true> or C<false>)
  69. on a match.
  70.  
  71. =head1 SEE ALSO
  72.  
  73. L<Log::Log4perl::Filter>,
  74. L<Log::Log4perl::Filter::LevelRange>,
  75. L<Log::Log4perl::Filter::StringRange>,
  76. L<Log::Log4perl::Filter::Boolean>
  77.  
  78. =head1 AUTHOR
  79.  
  80. Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003
  81.  
  82. =cut
  83.