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 / TestArrayBuffer.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-28  |  2.4 KB  |  94 lines
  1. ##################################################
  2. package Log::Log4perl::Appender::TestArrayBuffer;
  3. ##################################################
  4. # Like Log::Log4perl::Appender::TestBuffer, just with 
  5. # array capability.
  6. # For testing only.
  7. ##################################################
  8.  
  9. use Params::Validate qw(validate SCALAR ARRAYREF CODEREF);
  10.  
  11. use base qw( Log::Log4perl::Appender::TestBuffer );
  12.  
  13. ##################################################
  14. # overriding superclass so we can get arrayrefs 
  15. # through in 'message'
  16. ##################################################
  17. sub log
  18. {
  19.     my $self = shift;
  20.  
  21.     my %p = validate( @_, { level => { type => SCALAR },
  22.                             message => {  },
  23.                             log4p_level => { type => SCALAR },
  24.                             log4p_category  => { type => SCALAR },
  25.                             name  => { type => SCALAR },
  26.                           } );
  27.  
  28.     return unless $self->_should_log($p{level});
  29.  
  30.     $p{message} = $self->_apply_callbacks(%p)
  31.         if $self->{callbacks};
  32.  
  33.     $self->log_message(%p);
  34. }
  35.  
  36. ##################################################
  37. sub log_message {   
  38. ##################################################
  39.     my $self = shift;
  40.     my %params = @_;
  41.  
  42.     $self->{buffer} .= "[$params{level}]: " if $LOG_PRIORITY;
  43.  
  44.     if(ref($params{message}) eq "ARRAY") {
  45.         $self->{buffer} .= "[" . join(',', @{$params{message}}) . "]";
  46.     } else {
  47.         $self->{buffer} .= $params{message};
  48.     }
  49. }
  50.  
  51. 1;
  52.  
  53. =head1 NAME
  54.  
  55. Log::Log4perl::Appender::TestArrayBuffer - Subclass of Appender::TestBuffer
  56.  
  57. =head1 SYNOPSIS
  58.  
  59.   use Log::Log4perl::Appender::TestArrayBuffer;
  60.  
  61.   my $appender = Log::Log4perl::Appender::TestArrayBuffer->new( 
  62.       name      => 'buffer',
  63.       min_level => 'debug',
  64.       );
  65.  
  66.       # Append to the buffer
  67.   $appender->log_message( 
  68.       level =  > 'alert', 
  69.       message => ['first', 'second', 'third'],
  70.       );
  71.  
  72.       # Retrieve the result
  73.   my $result = $appender->buffer();
  74.  
  75.       # Reset the buffer to the empty string
  76.   $appender->reset();
  77.  
  78. =head1 DESCRIPTION
  79.  
  80. This class is a subclass of Log::Log4perl::Appender::TestBuffer and
  81. just provides message array refs as an additional feature. 
  82.  
  83. Just like Log::Log4perl::Appender::TestBuffer, 
  84. Log::Log4perl::Appender::TestArrayBuffer is used for internal
  85. Log::Log4perl testing only.
  86.  
  87. =head1 SEE ALSO
  88.  
  89. =head1 AUTHOR
  90.  
  91. Mike Schilli, E<lt>m@perlmeister.comE<gt>
  92.  
  93. =cut
  94.