File Coverage

blib/lib/Log/Agent/Driver/Apache.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Log::Agent::Driver::Apache;
use 5.008006;
use strict;
use warnings;
use Apache2::Log;
use Apache2::ServerUtil;
use Log::Agent::Driver;

our(@ISA) = qw(Log::Agent::Driver);
our($VERSION) = 0.002;
use vars qw(%PRI_MAP);

#
# %PRI_MAP is a mapping of priorities to underlying Apache2::Log->log()->$method
#
#  priority => method. Others, not listed, are info and debug.
%PRI_MAP = (
	emergency => 'emerg',
	alert => 'alert',
	critical => 'crit',
	error => 'error',
	warning => 'warn',
	notice => 'notice'
);

# this is the constructor.
sub make {
	my($this) = shift;
	my(%opt) = @_;
	$this = ref($this) || $this;
	my($self) = bless({},$this);
	$self->{'_apache_log'} = $opt{'-log'} || _default_log();
	return($self);
}

# By default, we use server log.
sub _default_log {
	my $s = Apache2::ServerUtil->server();
	return($s->log);
}
sub channel_eq {
	my($self,$ch1,$ch2) = (shift,shift,shift);
	return(1);
}

sub write {
	my($self,$channel,$priority,$logstring) = @_;
	my($l) = $self->{_apache_log} || 0;
	# Attempt to log something without logging anything?
	$logstring ||= join(",",caller()) . " (something was logged)";
	if(! $l){
		# Since the message may have something to do
		# with Apache::Log itself, or, misconfiguration
		# or the other things that can go wrong.. we issue
		# a warn here.
		warn "(log config. prob) $priority $logstring";
		return;
	}
	if($channel eq 'debug'){
		$l->debug($logstring);
		return();
	}
	$priority ||= 0;
	my($meth);
	if($l->can($priority)){
		$meth = $priority;
	}else{
		$meth = 'info'; # A reasonable default?
	}
	eval {
		$l->$meth($logstring);
	};
	if($@){
		warn "$@ $logstring"; # Couldn't log for some reason?
	}
	return();
}
# Map priorities to methods.
sub map_pri {
    my ($self,$priority, $level) = (shift,shift,shift);
	my($l) = $self->{_apache_log} || 0;
	if($l){
		if($l->can($priority)){
			return($priority);
		}
	}
	return($PRI_MAP{$priority});
}

sub prefix_msg {
	shift; # self,
	return(shift()); # Whatever the message is.
}

1;
__END__