[log4perl-devel] Revisit of database logging when database connection fails

[Robert J. <yad...@sn...>]

Way back around 9/26/2006, I posted a question (Subject: question regarding logging to databases), which, thanks to Mike Schilli and John ORourke, I was able to get working.  In summary, basically I needed Appender::DBI to cache log messages when the database is not working -- I implemented a wrapper module (DBI_wrapper.pm -- code below) to do it.

However, today it seems my wrapper failed to notice the connection failure in one case, even though it seemed to work fine for all the other times.  Basically what is happening is that the database server (mysql) is closing the connection server-side because no data had been sent for a long period of time.  My program doesn't recognize that the handle is now invalid until it tries to log a message.

As I said, most of the time it seemed to reconnect fine, but in one case, I got the error:

	Log4perl: DBI appender failed to reconnect to database after 1 attempt to DBI_wrapper.pm line 134

This error did not appear for any of the previous stale database connections.  In this case, my perl program exited due to this failure.

For this program, log messages are usually hours apart and stale connections are going to happen a lot.  I'm open to other ideas, but I was thinking that I should change the appender so that it connects, writes the message, and disconnects immediately.

So what do you think?  If that's the right way to go -- is there an easy way I can wrap the existing log() method in Appender::DBI to do the connect/disconnect (including, I guess, not doing _init() on new()?

Thanks for your time,
Rob


---- DBI_wrapper.pm
package DBI_wrapper;

use warnings;
use strict;

use Carp;
use DBI;
use Data::Dumper;

require Log::Log4perl::Appender::DBI;

sub new {
	my ($class, %options) = @_;

	my $appender = Log::Log4perl::Appender::DBI->new(
		map { $_ => $options{$_} } keys %options,
	);

	my $self = {
		appender => $appender,
		name => $options{name},
		BUFFERSIZE => 2000,
		connected => 0,
		};

	if (exists $options{BUFFERSIZE}) {
		$self->{BUFFERSIZE} = $options{BUFFERSIZE};
	}
	#print "buffersize is " , $self->{BUFFERSIZE} . $self->{name} . "\n";

	bless $self, $class;
	$self->_init(%options);

	return $self;

}

sub log {
	my ($self, %p) = @_;

	# Check for DB connection
	if (! $self->{dbh}->ping() ) {
		if ($self->{connected}) {
			# Notify FOT
			$self->_notify(%p);
			my %dupe = %p;
			$dupe{message} = "Database connection went down at " . scalar gmtime;
			$dupe{log4p_level} = 'ERROR';
			# This is required to store the original time of the message
			$dupe{log4p_logtime} = $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'}->() if exists $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'};
			$self->buffer(\%dupe);
		}

		# Buffer the message
		# This is required to store the original time of the message
		$p{log4p_logtime} = $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'}->() if exists $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'};
		$self->buffer(\%p);

		# Try to reconnect
		eval {
			$self->{dbh} = $self->{connect}->();
		};
		$self->{connected} = 0;
		return 1;
	} else {
		if (not $self->{connected} ) {
			my %dupe = %p;
			$dupe{message} = "Database connection came back up at " . scalar gmtime;
			$dupe{log4p_level} = 'ERROR'; # Not an ERROR but we want attention on this
			# This is required to store the original time of the message
			$dupe{log4p_logtime} = $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'}->() if exists $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'};
			$self->buffer(\%dupe);
		}
		$self->{connected_time} = scalar gmtime();
		$self->{connected} = 1;
	}

	$self->check_buffer();

	$Log::Log4perl::caller_depth++;

	$self->{appender}->log(
		%p,
		);

	$Log::Log4perl::caller_depth--;
	return 1;
}

sub _init {
	my $self = shift;
	my %params = @_;

    if ($params{dbh}) {
        $self->{dbh} = $params{dbh};
    } else {
        $self->{connect} = sub {
            DBI->connect(@params{qw(datasource username password)},
                         {PrintError => 0})
                            or croak "Log4perl: $DBI::errstr";
        };
        $self->{dbh} = $self->{connect}->();
		$self->{connected} = 1;
        $self->{_mine} = 1;
    }
}

sub _notify {
	my $self = shift;
	my %params = @_;

	# eventually send an email or something
	# for now just print a message
	print "Database is down\n";

}

sub check_buffer {
	my $self = shift;

	return unless ($self->{BUFFER} && ref $self->{BUFFER} eq 'ARRAY');

	while ( @{$self->{BUFFER}} ) {
		my $ref = shift @{$self->{BUFFER}};
		#print Dumper %$ref;
		$Log::Log4perl::caller_depth += 2;

		# Use the original time
		local $self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'}; 
		$self->{appender}->{'bind_value_layouts'}{'1'}{'time_function'} = 
			sub { $ref->{log4p_logtime} };

		$self->{appender}->log(
			%$ref,
			);
		$Log::Log4perl::caller_depth -= 2;
	}

	return 1;
}

sub buffer {
	my $self = shift;
	my $hashref = shift;

	if (defined @{$self->{BUFFER}} && (scalar @{$self->{BUFFER}} > $self->{BUFFERSIZE}) ) {
		# drop oldest message
		print "BUFFER EXCEEDED!\n";
		shift @{$self->{BUFFER}};
	} else {
		push @{$self->{BUFFER}}, $hashref;
	}
}

1;
---- End DBI_wrapper.pm