File Coverage

blib/lib/Apache/DBILogger.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Apache::DBILogger;

require 5.004;
use strict;
use Apache::Constants qw( :common );
use DBI;
use Date::Format;

$Apache::DBILogger::revision = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/o);
	$Apache::DBILogger::VERSION = "0.93";

sub reconnect($$) {
	my ($dbhref, $r) = @_;

	$$dbhref->disconnect;

	$r->log_error("Reconnecting to DBI server");

	$$dbhref = DBI->connect($r->dir_config("DBILogger_data_source"), $r->dir_config("DBILogger_username"), $r->dir_config("DBILogger_password"));

  	unless ($$dbhref) {
  		$r->log_error("Apache::DBILogger could not connect to ".$r->dir_config("DBILogger_data_source")." - ".$DBI::errstr);
  		return DECLINED;
  	}
}

sub logger {
	my $r = shift->last;

	my $s = $r->server;
	my $c = $r->connection;

	my %data = (
		    'server'	=> $s->server_hostname,
		    'bytes'     => $r->bytes_sent,
		    'filename'	=> $r->filename || '',
		    'remotehost'=> $c->remote_host || '',
		    'remoteip'  => $c->remote_ip || '',
		    'status'    => $r->status || '',
		    'urlpath'	=> $r->uri || '',
		    'referer'	=> $r->header_in("Referer") || '',
		    'useragent'	=> $r->header_in('User-Agent') || '',
		    'timeserved'=> time2str("%Y-%m-%d %X", time),
		    'contenttype' => $r->content_type || ''
	);

	if (my $user = $c->user) {
		$data{user} = $user;
	}

	$data{usertrack} = $r->notes('cookie') || '';

	my $dbh = DBI->connect($r->dir_config("DBILogger_data_source"), $r->dir_config("DBILogger_username"), $r->dir_config("DBILogger_password"));

  	unless ($dbh) {
  		$r->log_error("Apache::DBILogger could not connect to ".$r->dir_config("DBILogger_data_source")." - ".$DBI::errstr);
  		return DECLINED;
  	}

  	my @valueslist;

  	foreach (keys %data) {
		$data{$_} = $dbh->quote($data{$_});
		push @valueslist, $data{$_};
	}

	my $table = $r->dir_config("DBILogger_table") || 'requests';

	my $statement = "insert into $table (". join(',', keys %data) .") VALUES (". join(',', @valueslist) .")";

	my $tries = 0;

  	TRYAGAIN: my $sth = $dbh->prepare($statement);

  	unless ($sth) {
  		$r->log_error("Apache::DBILogger could not prepare sql query ($statement): $DBI::errstr");
  		return DECLINED;
  	}

	my $rv = $sth->execute;

	unless ($rv) {
		$r->log_error("Apache::DBILogger had problems executing query ($statement): $DBI::errstr");
	#	unless ($tries++ > 1) {
	#		&reconnect(\$dbh, $r);
	#		goto TRYAGAIN;
	#	}
	}

	$sth->finish;


	$dbh->disconnect;

	OK;
}

# #perl pun:  windows is for users who can't handle the power of the mac.

sub handler {
	shift->post_connection(\&logger);
	return OK;
}

1;
__END__