MMAgic/Log/Apache.pm

Go to the documentation of this file.

package MMAgic::Log::Apache;
#
# MMAgic/Log/Apache.pm
#
#   Log stream that redirects to Apache logging functions.
#

use     strict;
use     warnings;
use     UNIVERSAL   qw(isa);

use     Apache::Log;
use     Apache::ServerUtil;

use     MMAgic::Log;

our     @ISA = qw(MMAgic::Log);

###########################################################################
###########################################################################
sub new         #
#
    {
    bless { code => 'T' }, shift
    }

###########################################################################
###########################################################################
sub flush   # $self
# Flush pending output.
#   Perl doesn't directly support any flushing functionality,
#   it makes do with autoflush, but we have string buffering to flush:
#
    {
    my  $self = shift;

    if ($self->{useStr})
        {
        # After this data will go directly to the
        #   normal output:
        delete $self->{useStr};

        # Process any existing string data:
        if (defined $self->{string} && length  $self->{string})
            {
            map {
                $self->process($_)
                } split(/\n/, $self->{string});
            }

        # OK, we can jettison this now:
        delete $self->{string};
        }
    }

###########################################################################
sub process # $self, @list
# Print or store the specified items.
#   We do ASSUME here that newlines are always separate strings,
#   which should be true given the way MMAgic::Output works.
#
    {
    my  $self = shift;

#   lock($self);

    # Look for string first to handle buffering cases:

    if ($self->{useStr})
        {
        $self->{string} .= join '', @_;
        }
    
    else
        {
        my  $log  = Apache->server->log;

        map {
            if ($_ ne "\n")
                {
                $self->{_apLine_} .= $_;
                }
            
            elsif ($self->{_apLine_})
                {
                my  $code = $self->{_apLine_} =~ s/^\s*\[(.)\]\s// ? $1 : ' ';
    
                if ($code eq 'C')
                    {
                    $log->crit($self->{_apLine_});
                    }
                
                elsif ($code eq 'E')
                    {
                    $log->error($self->{_apLine_});
                    }
                
                elsif ($code eq 'W')
                    {
                    $log->warn($self->{_apLine_});
                    }
                
                elsif ($code eq 'I')
                    {
                    $log->notice($self->{_apLine_});
                    }
                
                else
                    {
                    $log->info($self->{_apLine_});
                    }

                delete $self->{_apLine_};
                }
            } @_;
        }
    
    return $self;
    }

###########################################################################
sub timestamp   # [ $clasSelf ] [ $when ]
#
    {
    ''
    }

1