This is related to the thread "Intermittent problems when using signal
to reread log configuration", but it focuses more on where I think the
problem is (i.e. my code).  I'm hoping someone will be able to tell me
where I'm going wrong!

I'm having some trouble with a subclass of the DBI appender I have
written.  I call it "DBI_Buffer" (attached).  It is basically a wrapper
around the DBI appender to handle buffering when the database is down.

It  does a ping for every log message (inefficient, I know!).  If the
ping fails, it attempts to reconnect (up to X configured number of
times).  If it fails to reconnect, it stores log messages in an array.
It then periodically checks to see if the database has come back up.
When the connection is restored, it flushes the buffered messages to the
database.

(BTW, if someone knows a better way to prevent blocking when attempting
to log while the database is down, I'd love to hear it!)

I'm also using init_and_watch to reread my Log4perl config when the
process receives SIGHUP.

If I use the included DBI appender, when I send a SIGHUP to any perl
process using that appender, it closes the existing connections and
makes new ones.

But when I am using my DBI_Buffer appender, it doesn't close the
existing database connections.  It does however make new ones, and
logging continues to work.  However, since the connections to the DB
stick around basically forever -- eventually I run out of connections!
Unfortunately the error I get is not usually "Too many connections"; it
is instead:
        Can't call method "log" on an undefined value at
/opt/ActivePerl-5.8/lib/site_perl/5.8.7/Log/Log4perl/Appender.pm line 189.

I'm puzzled why I get this misleading error, but, well at least I know
it is because I have run out of mysql connections.

It seems to perhaps be related to the post_init() check I do (which I
borrowed from Log::Log4perl::Appender::Synchronized).  If the user wants
to log database errors to a local logfile, they define an
"errorappender" in the DBI_Buffer config.

What's telling is that if I remove the "errorappender" definition from
the config (thus removing the need to call post_init), I don't have a
problem with stupidly persistent DB connections.

I think this is a clue:  Synchronized has this line of code:
        push @{$options{l4p_depends_on}}, $self->{appender};

But I do not.

If I add equivalent code to my existing conditional for the definition
of errorappender, i.e.:

    if ($self->{errorappender}) {
        # Pass back the appender to be synchronized as a dependency
        # to the configuration file parser
        push @{$p{l4p_depends_on}}, $self->{errorappender};
        push @{$p{l4p_post_config_subs}}, sub { $self->post_init() };
    }

Then I get this error from Log::Log4perl::Appender::DBI:

Log4perl: DBI appender failed to reconnect to database after 1 attempt
at init_and_watch.pl line 10

(minimal test program and config attached as well)

To reproduce, you need a mysql server and associated tables.  Edit the
attached config to match.

Then run init_and_watch.pl in the background.  Use a mysql client to
look at the current connections.  For mysql 4.1 and 5.x, this works:
        show processlist;

Send a SIGHUP to the running perl process, and check the mysql
processlist again.  There will be a new one.

---------
Side question (somewhat related): both DBI and DBI_Buffer seem to make
connections to databases aren't really necessary.  In other words, if
all of these conditions are true:
        1) "Database1" and "Database2" are both defined in the config file as
DBI appenders
        2)  Two categories are defined that use both Database appenders, e.g.:
        log4perl.category.DB1 = INFO, Database1
        log4perl.category.DB2 = INFO, Database2

        3)  Run a program that only uses the "DB1" category, e.g:
        my $logger = get_logger("DB1");

Then it it makes connections to both databases, even though only DB1 is
used.  Is this expected behavior?    I know this behavior isn't causing
my problem, because if I SIGHUP a program using the DBI appender, the
connections are remade instead of hanging around needlessly as when I
use DBI_Buffer.  I'm just curious.

-- 
Rob
package DBI_Buffer;
use base ("Log::Log4perl::Appender::DBI");

use strict;
use warnings;

use Time::HiRes;
use Data::Dumper;

use vars qw ($VERSION);
$VERSION = "1.06";

##########################################
sub new {
###########################################
        my($proto, %p) = @_;
        my $class = ref $proto || $proto;

        my $self = bless {}, $class;

        $self->_init(%p);

        my %defaults = (
                reconnect_attempts => 1,
                reconnect_sleep    => 0,
                logbuffer          => 2000,
                buffer             => [],
                connected          => 1,
                errorstodatabase   => 1,
                signal_caught      => 0,
        );

        for (keys %defaults) {
                if(exists $p{$_}) {
                        $self->{$_} = $p{$_};
                } else {
                        $self->{$_} = $defaults{$_};
                }
        }

        #e.g.
        #log4j.appender.DBAppndr.params.1 = %p  
        #log4j.appender.DBAppndr.params.2 = %5.5m
        foreach my $pnum (keys %{$p{params}}){
                $self->{bind_value_layouts}{$pnum} = 
                                Log::Log4perl::Layout::PatternLayout->new(
                                        {ConversionPattern => {value  => 
$p{params}->{$pnum}}});
        }
        #'bind_value_layouts' now contains a PatternLayout
        #for each parameter heading for the Sql engine

        $self->{SQL} = $p{sql}; #save for error msg later on

        $self->{MAX_COL_SIZE} = $p{max_col_size};

        $self->{BUFFERSIZE} = $p{bufferSize} || 1; 

        $self->{errorappender} = $p{errorappender} if exists $p{errorappender};

        $self->{errorstodatabase} = $p{errorstodatabase} if exists 
$p{errorstodatabase};

        $self->{flushsignal} = $p{flushsignal} if exists $p{flushsignal};

        if ($self->{flushsignal}) {
                #$self->{watcher} = Log::Log4perl::Config::Watch->new(
                        #file   => '/dev/null', # no file needed
                        #signal => $self->{flushsignal}
                #);
                # Install a signal handler
                $SIG{$self->{flushsignal}} = sub {
                        $self->{signal_caught} = 1;
                        print STDERR __PACKAGE__.": We get signal!\n";
                        $self->flush;
                        $self->{signal_caught} = 0;
                }
        }

        # Run our post_init method in the configurator after
        # all appenders have been defined to make sure the
        # appenders we're connecting to really exist.
        if ($self->{errorappender}) {
                push @{$p{l4p_post_config_subs}}, sub { $self->post_init() };
        }
        
        if ($p{usePreparedStmt}) {
                $self->{sth} = $self->create_statement($p{sql});
                $self->{usePreparedStmt} = 1;
        }else{
                $self->{layout} = Log::Log4perl::Layout::PatternLayout->new(
                                        {ConversionPattern => {value  => 
$p{sql}}});
        }

        if ($self->{usePreparedStmt} &&  $self->{bufferSize}){
                warn "Log4perl: you've defined both usePreparedStmt and 
bufferSize \n".
                "in your appender '$p{name}'--\n".
                "I'm going to ignore bufferSize and just use a prepared stmt\n";
        }

        return $self;
}

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

        if ( @{$self->{buffer}} == $self->{logbuffer} ) {
                #print "Discarding 1 message\n";
                shift @{$self->{buffer}};
        }

        $p{log4p_logtime} = 
$self->{'bind_value_layouts'}{'1'}{'time_function'}->() if exists 
$self->{'bind_value_layouts'}{'1'}{'time_function'};

        push @{$self->{buffer}}, \%p;

        #print Dumper $self->{buffer};

        #print Dumper %p;

        # Database connection working?
        if ($self->check_connection(%p) ) {
                # OK, flush buffer
                $self->flush;
        } else {
                if ($self->{connected}) {
                        log_message($self, 3, 'ERROR', "Database connection 
failed at " . scalar gmtime , %p);
                        $self->{connected} = 0;
                }
                #print "not connected\n";
        }
}

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

        # This test code will force this appender to buffer the messages
        # until there are 3 msgs in the buffer
        #print "counter is ", scalar @{$self->{buffer}};
        #return 0 if ( @{$self->{buffer}} < 3 );
        # End test code

        return 1 if ($self->{dying});

        for my $attempt (0..$self->{reconnect_attempts}) {
                if (! $self->{dbh}->ping() ) {
                        if ($attempt) {
                                sleep($self->{reconnect_sleep}) if 
$self->{reconnect_sleep};
                        }
                        eval {
                                $self->{dbh} = $self->{connect}->();
                        };
                        if ($@) {
                                #print "failed reconnect\n";
                                return 0 if ($attempt == 
$self->{reconnect_attempts});
                        } else {
                                #print "reconnect OK\n";
                                if ($self->{connected}) {
                                        log_message($self, 4, 'ERROR', 
"Database connection lost and reestablished at " . scalar gmtime , %p);
                                }
                                # Recreate sth
                                my $sth = $self->create_statement($self->{SQL});
                                $self->{sth} = $sth if $self->{sth};
                                last;
                        }
                }
        }
        if (not $self->{connected}) {
                log_message($self, 4, 'ERROR', "Database connection 
reestablished at " . scalar gmtime , %p);
        }
        $self->{connected} = 1;
        return 1;
}

###########################################
sub flush {
###########################################
        my ($self) = @_;

        if ($self->{signal_caught}) {
                # User sent signal, they must want to write the buffer
                # But first we have to be connected!
                if (! $self->{dbh}->ping() ) {
                        # Force reconnect attempt
                        eval { $self->{dbh} = $self->{connect}->();};
                        if ($@) {
                                # I'd like to log to the error appender here, 
but
                                # first I need to figure out how to get the 
appender name
                                # and category.  If the buffer isn't emtpy I 
can dupe an
                                # existing message, otherwise print to screen
                                if ( @{$self->{buffer}} ) {
                                        my $ref = @{$self->{buffer}}[0];
                                        my %dupe = %$ref;
                                        my $message = "Tried to flush but could 
not reconnect " . scalar gmtime;
                                        $dupe{message} = $message;
                                        $dupe{log4p_logtime} = time();
                                        # Log to errorappender
                                        log_message($self, 1, 'ERROR', $message 
, %dupe);
                                } else {
                                        print STDERR __PACKAGE__.": Tried to 
flush but could not reconnect\n";
                                }
                                return 0;
                        } else {
                                print STDERR __PACKAGE__.": Main screen turn 
on!\n";
                                # Recreate sth
                                my $sth =  
$self->create_statement($self->{SQL});
                                $self->{sth} = $sth if $self->{sth};
                        }
                }
        }

        for ( @{$self->{buffer}} ) {
                #print Dumper $_;
                local $self->{'bind_value_layouts'}{'1'}{'time_function'};
                $self->{'bind_value_layouts'}{'1'}{'time_function'} =
                        sub { $_->{log4p_logtime} } ;
                $Log::Log4perl::caller_depth += 2 if (! $self->{signal_caught});
                $self->SUPER::log(%$_);
                $Log::Log4perl::caller_depth -= 2 if (! $self->{signal_caught});
        }

        # Empty buffer
        $self->{buffer} = [];

        return 1;
}


# This sub logs a message to the database, and to the appender
# specified as the "errorappender" in the config file
###########################################
sub log_message {
###########################################
        my $self = shift;
        my $depth = shift;
        my $levelname = shift;
        my $message = shift;
        my %params = @_;

        # Note that even though we are changing the level here, the messages
        # are always logged, regardless of the appender threshold
        # Why do I bother, then?  I don't know!
        my $levelstring = Log::Log4perl::Level::to_priority($levelname);
        my $level = substr($levelstring, 0,1);
        $params{log4p_level} = $levelname;
        $params{level} = $level;

        $params{message} = $message;
        $params{log4p_logtime} = $self->{app}->{layout}->{time_function}->()
                if exists $self->{app}->{layout}->{time_function};

        #print Dumper %params;

        # Have to copy %params to %dupe, otherwise
        # it ends up joining all the fields into the message field
        if ($self->{errorstodatabase}) {
                my %dupe = %params;
                push @{$self->{buffer}}, \%dupe;
        }

        # Now log to the errorappender
        if ($self->{errorappender}) {
                #print "appender is ", $self->{errorappender} , "\n";
                #my $app = 
Log::Log4perl->appender_by_name($self->{errorappender});
                #print Dumper $app;

                $Log::Log4perl::caller_depth += $depth;
                $self->{app}->log(\%params, $params{log4p_category}, 
$params{log4p_level});
                $Log::Log4perl::caller_depth -= $depth;
        }
}

###########################################
sub post_init {
###########################################
        my($self) = @_;

        if(! exists $self->{errorappender}) {
           die "No error appender defined for " . __PACKAGE__;
        }

        my $appenders = Log::Log4perl->appenders();
        my $appender = Log::Log4perl->appenders()->{$self->{errorappender}};

        if(! defined $appender) {
           die "Appender $self->{errorappender} not defined (yet) when " .
                   __PACKAGE__ . " needed it";
        }

        $self->{app} = $appender;
}

sub DESTROY {
        my $self = shift;

        #my $app = $self->{errorappender};
        #my %params = 
        #{ name    => $app,
          #level   => 'DEBUG',
          #message => "DESTROYING DBI_Buffer",
          #log4p_category => "ANS.event",
          #log4p_level  => 0,
        #};
#
        #my $depth = 3;

        #if ($self->{errorappender}) {
                #$Log::Log4perl::caller_depth += $depth;
                #$self->{app}->log(\%params, $params{log4p_category}, 
$params{log4p_level});
                #$Log::Log4perl::caller_depth -= $depth;
        #}

        $self->{dying} = 1;
        $self->SUPER::DESTROY();

}

1;

__END__


=head1 NAME

DBI_Buffer - subclass of L<Log::Log4perl::Appender::DBI>, with buffering

=head1 SYNOPSIS

    my $config = <<'EOT';
    log4j.category = WARN, DBAppndr
    log4j.appender.DBAppndr               = DBI_Buffer
    log4j.appender.DBAppndr.datasource    = 
DBI:mysql:database=logdb:host=localhost
    log4j.appender.DBAppndr.username      = bobjones
    log4j.appender.DBAppndr.password      = 12345
    log4j.appender.DBAppndr.logbuffer     = 2000
    log4j.appender.DBAppndr.errorappender = Logfile
    log4j.appender.DBAppndr.flushsignal   = USR2
    log4j.appender.DBAppndr.errorstodatabase   = 1
    log4j.appender.DBAppndr.sql         = \
       insert into log4perltest           \
       (date, loglevel, filename, hostname, PID, message) \
       values (?,?,?,?,?,?)
    log4j.appender.DBAppndr.params.1 = %d{yyyy/DDD/HH:mm:ss}
    log4j.appender.DBAppndr.params.2 = %p    
    log4j.appender.DBAppndr.params.3 = %F{2}    
    log4j.appender.DBAppndr.params.4 = %H    
    log4j.appender.DBAppndr.params.5 = %P
    log4j.appender.DBAppndr.params.6 = %m
        
    
    log4j.appender.DBAppndr.usePreparedStmt = 1
    
    #just pass through the array of message items in the log statement 
    log4j.appender.DBAppndr.layout    = Log::Log4perl::Layout::NoopLayout
    log4j.appender.DBAppndr.warp_message = 0
    EOT
    
    $logger->warn( $custid, 'big problem!!', $ip_addr );


=head1 DESCRIPTION

This is a sepecialized subclass of Log::Log4perl::Appender::DBI, with
provision for an in-memory buffer of log messages for when the logger
cannot connect to the database for whatever reason; i.e. if the database
is down, messages are buffered until the database comes back up.

Buffer size is controlled via the logbuffer option.

=head1 OPTIONS

In addition to the options supported by L<Log::Log4perl::Appender::DBI>, 
DBI_Buffer supports the following options:

=over 4

=item logbuffer

The number of log messages to buffer in memory.  If the buffer is
exceeded, the oldest message is dropped.  The default size is 2000
messages.

=item errorappender

If errorappender is defined, and DBI_Buffer cannot connect to the database,
it will log error messages to this appender.  errorappender must be
defined in the Log4perl configuration, or DBI_Buffer will fail to init.

=item flushsignal

Normally, DBI_Buffer will only write messages to the database upon
receiving a log() request.  However, if the database goes down, and
messages are buffered, then DBI_Buffer will not notice the database
is available until the next log() call.  In other words, if log()
calls are infrequent, messages may remain in the buffer if the database
becomes available.  Send the flushsignal to the process in order to 
force DBI_Buffer to reconnect to the database and flush its buffer.

If DBI_Buffer cannot reconnect and flush, it will log an error to the
errorappender (if it is defined), or STDERR.

=item errorstodatabase

By default, DBI_Buffer will log connection errors to the database. To
turn off this behavior, set errorstodatabase to 0.

=back

=head1 NOTES

DBI_Buffer has not been tested when the log() call has more than one
element and warp_message=0 e.g.

        $logger->info( $arg1, $arg2, $arg3);

may not work. (If warp_message=1 -- the default -- then the arguments
will be joined into one element and so it will work fine)

=head1 AUTHOR

Robert Jacobson <..........................> January, 2007

=head1 SEE ALSO

L<Log::Log4perl::Appender::DBI>

=cut
##
## Categories for each ANS module
## 
log4perl.category.ANS           = DEBUG, Logfile, Database

##
## Logfile appender 
##
log4perl.appender.Logfile       = Log::Log4perl::Appender::File
log4perl.appender.Logfile.filename = 'ANSlog.txt'
log4perl.appender.Logfile.recreate = 1
log4perl.appender.Logfile.layout= Log::Log4perl::Layout::PatternLayout
log4perl.appender.Logfile.layout.ConversionPattern = \
         %d{yyyy-DDD/HH:mm:ss} %-5p %F{2} %P %m%n

##
## Database Appender
##
# NOTE: DBI_Buffer uses all options from Log::Log4perl::Appender::DBI
log4perl.appender.Database      = DBI_Buffer
log4perl.appender.Database.usePreparedStmt = 1
log4perl.appender.Database.layout       = Log::Log4perl::Layout::NoopLayout
log4perl.appender.Database.datasource   = 
DBI:mysql:database=ansdb:host=localhost;mysql_auto_reconnect=1
log4perl.appender.Database.username     = ans
log4perl.appender.Database.password     = anslog4perl
log4perl.appender.Database.logbuffer    = 4000
log4perl.appender.Database.errorappender= Logfile
log4perl.appender.Database.sql      = \
    insert into anslog      \
    (date, loglevel, filename, hostname, PID, message) \
    values (?,?,?,?,?,?)
log4perl.appender.Database.params.1   = %d{yyyy-DDD/HH:mm:ss}
log4perl.appender.Database.params.2   = %p
log4perl.appender.Database.params.3   = %F{2}
log4perl.appender.Database.params.4   = %H
log4perl.appender.Database.params.5   = %P
log4perl.appender.Database.params.6   = %m

#!/opt/ActivePerl-5.8/bin/perl

use Log::Log4perl qw(get_logger :levels);
use strict;

use lib ".";
Log::Log4perl->init_and_watch("log4perl.conf",'HUP');
my $logger = get_logger("ANS");

while (1) {
        $logger->info("info before sleep");
        $logger->debug("debug before sleep");
        sleep 5;
        $logger->info("info after sleep");
        $logger->debug("debug after sleep");
}

------------------------------------------------------------------------------
Open Source Business Conference (OSBC), March 24-25, 2009, San Francisco, CA
-OSBC tackles the biggest issue in open source: Open Sourcing the Enterprise
-Strategies to boost innovation and cut costs with open source participation
-Receive a $600 discount off the registration fee with the source code: SFAD
http://p.sf.net/sfu/XcvMzF8H
_______________________________________________
log4perl-devel mailing list
log4perl-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/log4perl-devel

Reply via email to