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 / StringMatch.pm < prev    next >
Encoding:
Perl POD Document  |  2003-03-14  |  2.2 KB  |  90 lines
  1. ##################################################
  2. package Log::Log4perl::Filter::StringMatch;
  3. ##################################################
  4.  
  5. use 5.006;
  6.  
  7. use strict;
  8. use warnings;
  9.  
  10. use Log::Log4perl::Config;
  11.  
  12. use constant DEBUG => 0;
  13.  
  14. use base "Log::Log4perl::Filter";
  15.  
  16. ##################################################
  17. sub new {
  18. ##################################################
  19.      my ($class, %options) = @_;
  20.  
  21.      print join('-', %options) if DEBUG;
  22.  
  23.      my $self = { StringToMatch => '',
  24.                   AcceptOnMatch => 1,
  25.                   %options,
  26.                 };
  27.      
  28.      $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish(
  29.                                                  $self->{AcceptOnMatch});
  30.  
  31.      $self->{StringToMatch} = qr($self->{StringToMatch});
  32.  
  33.      bless $self, $class;
  34.  
  35.      return $self;
  36. }
  37.  
  38. ##################################################
  39. sub ok {
  40. ##################################################
  41.      my ($self, %p) = @_;
  42.  
  43.      local($_) = join $
  44.                      Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}};
  45.  
  46.      if($_ =~ $self->{StringToMatch}) {
  47.          print "Strings match\n" if DEBUG;
  48.          return $self->{AcceptOnMatch};
  49.      } else {
  50.          print "Strings don't match ($_/$self->{StringToMatch})\n" if DEBUG;
  51.          return !$self->{AcceptOnMatch};
  52.      }
  53. }
  54.  
  55. 1;
  56.  
  57. __END__
  58.  
  59. =head1 NAME
  60.  
  61. Log::Log4perl::Filter::StringMatch - Filter to match the log level exactly
  62.  
  63. =head1 SYNOPSIS
  64.  
  65.     log4perl.filter.Match1               = Log::Log4perl::Filter::StringMatch
  66.     log4perl.filter.Match1.StringToMatch = blah blah
  67.     log4perl.filter.Match1.AcceptOnMatch = true
  68.  
  69. =head1 DESCRIPTION
  70.  
  71. This Log4perl custom filter checks if the currently submitted message
  72. matches a predefined regular expression, as set in the C<StringToMatch>
  73. parameter. It uses common Perl 5 regexes.
  74.  
  75. The additional parameter C<AcceptOnMatch> defines if the filter
  76. is supposed to pass or block the message on a match (C<true> or C<false>).
  77.  
  78. =head1 SEE ALSO
  79.  
  80. L<Log::Log4perl::Filter>,
  81. L<Log::Log4perl::Filter::LevelMatch>,
  82. L<Log::Log4perl::Filter::LevelRange>,
  83. L<Log::Log4perl::Filter::Boolean>
  84.  
  85. =head1 AUTHOR
  86.  
  87. Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>, 2003
  88.  
  89. =cut
  90.