﻿eaiovnaovbqoebvqoeavibavo
PK     �&jZv9�I*  I*    Limit.pmnu �[���        ######################################################################
# Limit.pm -- 2003, Mike Schilli <m@perlmeister.com>
######################################################################
# Special composite appender limiting the number of messages relayed
# to its appender(s).
######################################################################

###########################################
package Log::Log4perl::Appender::Limit;
###########################################

use strict;
use warnings;
use Storable;

our @ISA = qw(Log::Log4perl::Appender);

our $CVSVERSION   = '$Revision: 1.7 $';
our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);

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

    my $self = {
        max_until_flushed   => undef,
        max_until_discarded => undef,
        appender_method_on_flush 
                            => undef,
        appender            => undef,
        accumulate          => 1,
        persistent          => undef,
        block_period        => 3600,
        buffer              => [],
        %options,
    };

        # Pass back the appender to be limited as a dependency
        # to the configuration file parser
    push @{$options{l4p_depends_on}}, $self->{appender};

        # 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.
    push @{$options{l4p_post_config_subs}}, sub { $self->post_init() };

    bless $self, $class;

    if(defined $self->{persistent}) {
        $self->restore();
    }

    return $self;
}

###########################################
sub log {
###########################################
    my($self, %params) = @_;
    
    local $Log::Log4perl::caller_depth =
        $Log::Log4perl::caller_depth + 2;

        # Check if message needs to be discarded
    my $discard = 0;
    if(defined $self->{max_until_discarded} and
       scalar @{$self->{buffer}} >= $self->{max_until_discarded} - 1) {
        $discard = 1;
    }

        # Check if we need to flush
    my $flush = 0;
    if(defined $self->{max_until_flushed} and
       scalar @{$self->{buffer}} >= $self->{max_until_flushed} - 1) {
        $flush = 1;
    }

    if(!$flush and
       (exists $self->{sent_last} and
        $self->{sent_last} + $self->{block_period} > time()
       )
      ) {
            # Message needs to be blocked for now.
        return if $discard;

            # Ask the appender to save a cached message in $cache
        $self->{app}->SUPER::log(\%params,
                             $params{log4p_category},
                             $params{log4p_level}, \my $cache);

            # Save message and other parameters
        push @{$self->{buffer}}, $cache if $self->{accumulate};

        $self->save() if $self->{persistent};

        return;
    }

    # Relay all messages we got to the SUPER class, which needs to render the
    # messages according to the appender's layout, first.

        # Log pending messages if we have any
    $self->flush();

        # Log current message as well
    $self->{app}->SUPER::log(\%params,
                             $params{log4p_category},
                             $params{log4p_level});

    $self->{sent_last} = time();

        # We need to store the timestamp persistently, if requested
    $self->save() if $self->{persistent};
}

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

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

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

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

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

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

    my $pdata = [$self->{buffer}, $self->{sent_last}];

        # Save the buffer if we're in persistent mode
    store $pdata, $self->{persistent} or
        die "Cannot save messages in $self->{persistent} ($!)";
}

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

    if(-f $self->{persistent}) {
        my $pdata = retrieve $self->{persistent} or
            die "Cannot retrieve messages from $self->{persistent} ($!)";
        ($self->{buffer}, $self->{sent_last}) = @$pdata;
    }
}

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

        # Log pending messages if we have any
    for(@{$self->{buffer}}) {
        $self->{app}->SUPER::log_cached($_);
    }

      # call flush() on the attached appender if so desired.
    if( $self->{appender_method_on_flush} ) {
        no strict 'refs';
        my $method = $self->{appender_method_on_flush};
        $self->{app}->$method();
    }

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

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

}

1;

__END__

=encoding utf8

=head1 NAME

    Log::Log4perl::Appender::Limit - Limit message delivery via block period

=head1 SYNOPSIS

    use Log::Log4perl qw(:easy);

    my $conf = qq(
      log4perl.category = WARN, Limiter
    
          # Email appender
      log4perl.appender.Mailer          = Log::Dispatch::Email::MailSend
      log4perl.appender.Mailer.to       = drone\@pageme.com
      log4perl.appender.Mailer.subject  = Something's broken!
      log4perl.appender.Mailer.buffered = 0
      log4perl.appender.Mailer.layout   = PatternLayout
      log4perl.appender.Mailer.layout.ConversionPattern=%d %m %n

          # Limiting appender, using the email appender above
      log4perl.appender.Limiter              = Log::Log4perl::Appender::Limit
      log4perl.appender.Limiter.appender     = Mailer
      log4perl.appender.Limiter.block_period = 3600
    );

    Log::Log4perl->init(\$conf);
    WARN("This message will be sent immediately.");
    WARN("This message will be delayed by one hour.");
    sleep(3601);
    WARN("This message plus the last one will be sent now, seperately.");

=head1 DESCRIPTION

=over 4

=item C<appender>

Specifies the name of the appender used by the limiter. The
appender specified must be defined somewhere in the configuration file,
not necessarily before the definition of 
C<Log::Log4perl::Appender::Limit>.

=item C<block_period>

Period in seconds between delivery of messages. If messages arrive in between,
they will be either saved (if C<accumulate> is set to a true value) or
discarded (if C<accumulate> isn't set).

=item C<persistent>

File name in which C<Log::Log4perl::Appender::Limit> persistently stores 
delivery times. If omitted, the appender will have no recollection of what
happened when the program restarts.

=item C<max_until_flushed>

Maximum number of accumulated messages. If exceeded, the appender flushes 
all messages, regardless if the interval set in C<block_period> 
has passed or not. Don't mix with C<max_until_discarded>.

=item C<max_until_discarded>

Maximum number of accumulated messages. If exceeded, the appender will
simply discard additional messages, waiting for C<block_period> to expire
to flush all accumulated messages. Don't mix with C<max_until_flushed>.

=item C<appender_method_on_flush>

Optional method name to be called on the appender attached to the
limiter when messages are flushed. For example, to have the sample code 
in the SYNOPSIS section bundle buffered emails into one, change the 
mailer's C<buffered> parameter to C<1> and set the limiters 
C<appender_method_on_flush> value to the string C<"flush">:

      log4perl.category = WARN, Limiter
    
          # Email appender
      log4perl.appender.Mailer          = Log::Dispatch::Email::MailSend
      log4perl.appender.Mailer.to       = drone\@pageme.com
      log4perl.appender.Mailer.subject  = Something's broken!
      log4perl.appender.Mailer.buffered = 1
      log4perl.appender.Mailer.layout   = PatternLayout
      log4perl.appender.Mailer.layout.ConversionPattern=%d %m %n

          # Limiting appender, using the email appender above
      log4perl.appender.Limiter              = Log::Log4perl::Appender::Limit
      log4perl.appender.Limiter.appender     = Mailer
      log4perl.appender.Limiter.block_period = 3600
      log4perl.appender.Limiter.appender_method_on_flush = flush

This will cause the mailer to buffer messages and wait for C<flush()>
to send out the whole batch. The limiter will then call the appender's
C<flush()> method when it's own buffer gets flushed out.

=back

If the appender attached to C<Limit> uses C<PatternLayout> with a timestamp
specifier, you will notice that the message timestamps are reflecting the
original log event, not the time of the message rendering in the
attached appender. Major trickery has been applied to accomplish 
this (Cough!).

=head1 DEVELOPMENT NOTES

C<Log::Log4perl::Appender::Limit> is a I<composite> appender.
Unlike other appenders, it doesn't log any messages, it just
passes them on to its attached sub-appender.
For this reason, it doesn't need a layout (contrary to regular appenders).
If it defines none, messages are passed on unaltered.

Custom filters are also applied to the composite appender only.
They are I<not> applied to the sub-appender. Same applies to appender
thresholds. This behaviour might change in the future.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ�I�      ScreenColoredLevels.pmnu �[���        ##################################################
package Log::Log4perl::Appender::ScreenColoredLevels;
##################################################
use Log::Log4perl::Appender::Screen;
our @ISA = qw(Log::Log4perl::Appender::Screen);

use warnings;
use strict;

use Term::ANSIColor qw();
use Log::Log4perl::Level;

BEGIN {
    $Term::ANSIColor::EACHLINE="\n";
}

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

    my %specific_options = ( color => {} );

    for my $option ( keys %specific_options ) {
        $specific_options{ $option } = delete $options{ $option } if
            exists $options{ $option };
    }

    my $self = $class->SUPER::new( %options );
    @$self{ keys %specific_options } = values %specific_options;
    bless $self, __PACKAGE__; # rebless

      # also accept lower/mixed case levels in config
    for my $level ( keys %{ $self->{color} } ) {
        my $uclevel = uc($level);
        $self->{color}->{$uclevel} = $self->{color}->{$level};
    }

    my %default_colors = (
        TRACE   => 'yellow',
        DEBUG   => '',
        INFO    => 'green',
        WARN    => 'blue',
        ERROR   => 'magenta',
        FATAL   => 'red',
    );
    for my $level ( keys %default_colors ) {
        if ( ! exists $self->{ 'color' }->{ $level } ) {
            $self->{ 'color' }->{ $level } = $default_colors{ $level };
        }
    }

    bless $self, $class;
}
    
##################################################
sub log {
##################################################
    my($self, %params) = @_;

    my $msg = $params{ 'message' };

    if ( my $color = $self->{ 'color' }->{ $params{ 'log4p_level' } } ) {
        $msg = Term::ANSIColor::colored( $msg, $color );
    }
    
    if($self->{stderr}) {
        print STDERR $msg;
    } else {
        print $msg;
    }
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::ScreenColoredLevel - Colorize messages according to level

=head1 SYNOPSIS

    use Log::Log4perl qw(:easy);

    Log::Log4perl->init(\ <<'EOT');
      log4perl.category = DEBUG, Screen
      log4perl.appender.Screen = \
          Log::Log4perl::Appender::ScreenColoredLevels
      log4perl.appender.Screen.layout = \
          Log::Log4perl::Layout::PatternLayout
      log4perl.appender.Screen.layout.ConversionPattern = \
          %d %F{1} %L> %m %n
    EOT

      # Appears black
    DEBUG "Debug Message";

      # Appears green
    INFO  "Info Message";

      # Appears blue
    WARN  "Warn Message";

      # Appears magenta
    ERROR "Error Message";

      # Appears red
    FATAL "Fatal Message";

=head1 DESCRIPTION

This appender acts like Log::Log4perl::Appender::Screen, except that
it colorizes its output, based on the priority of the message sent.

You can configure the colors and attributes used for the different
levels, by specifying them in your configuration:

    log4perl.appender.Screen.color.TRACE=cyan
    log4perl.appender.Screen.color.DEBUG=bold blue

You can also specify nothing, to indicate that level should not have
coloring applied, which means the text will be whatever the default
color for your terminal is.  This is the default for debug messages.

    log4perl.appender.Screen.color.DEBUG=

You can use any attribute supported by L<Term::ANSIColor> as a configuration
option.

    log4perl.appender.Screen.color.FATAL=\
        bold underline blink red on_white

The commonly used colors and attributes are:

=over 4

=item attributes

BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK

=item colors

BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE

=item background colors

ON_BLACK, ON_RED, ON_GREEN, ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, ON_WHITE

=back

See L<Term::ANSIColor> for a complete list, and information on which are
supported by various common terminal emulators.

The default values for these options are:

=over 4

=item Trace

Yellow

=item Debug

None (whatever the terminal default is)

=item Info

Green

=item Warn

Blue

=item Error

Magenta

=item Fatal

Red

=back

The constructor C<new()> takes an optional parameter C<stderr>,
if set to a true value, the appender will log to STDERR. If C<stderr>
is set to a false value, it will log to STDOUT. The default setting
for C<stderr> is 1, so messages will be logged to STDERR by default.
The constructor can also take an optional parameter C<color>, whose
value is a  hashref of color configuration options, any levels that
are not included in the hashref will be set to their default values.

=head2 Using ScreenColoredLevels on Windows

Note that if you're using this appender on Windows, you need to fetch
Win32::Console::ANSI from CPAN and add

    use Win32::Console::ANSI;

to your script.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ,
q7i  i  	  Screen.pmnu �[���        ##################################################
package Log::Log4perl::Appender::Screen;
##################################################

our @ISA = qw(Log::Log4perl::Appender);

use warnings;
use strict;

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

    my $self = {
        name   => "unknown name",
        stderr => 1,
        utf8   => undef,
        @options,
    };

    if( $self->{utf8} ) {
        if( $self->{stderr} ) {
            binmode STDERR, ":utf8";
        } else {
            binmode STDOUT, ":utf8";
        }
    }

    bless $self, $class;
}
    
##################################################
sub log {
##################################################
    my($self, %params) = @_;

    if($self->{stderr}) {
        print STDERR $params{message};
    } else {
        print $params{message};
    }
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::Screen - Log to STDOUT/STDERR

=head1 SYNOPSIS

    use Log::Log4perl::Appender::Screen;

    my $app = Log::Log4perl::Appender::Screen->new(
      stderr    => 0,
      utf8      => 1,
    );

    $file->log(message => "Log me\n");

=head1 DESCRIPTION

This is a simple appender for writing to STDOUT or STDERR.

The constructor C<new()> take an optional parameter C<stderr>,
if set to a true value, the appender will log to STDERR. 
The default setting for C<stderr> is 1, so messages will be logged to 
STDERR by default.

If C<stderr>
is set to a false value, it will log to STDOUT (or, more accurately,
whichever file handle is selected via C<select()>, STDOUT by default). 

Design and implementation of this module has been greatly inspired by
Dave Rolsky's C<Log::Dispatch> appender framework.

To enable printing wide utf8 characters, set the utf8 option to a true
value:

    my $app = Log::Log4perl::Appender::Screen->new(
      stderr    => 1,
      utf8      => 1,
    );

This will issue the necessary binmode command to the selected output
channel (stderr/stdout).

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ�nN�(  �(    Synchronized.pmnu �[���        ######################################################################
# Synchronized.pm -- 2003, 2007 Mike Schilli <m@perlmeister.com>
######################################################################
# Special appender employing a locking strategy to synchronize
# access.
######################################################################

###########################################
package Log::Log4perl::Appender::Synchronized;
###########################################

use strict;
use warnings;
use Log::Log4perl::Util::Semaphore;

our @ISA = qw(Log::Log4perl::Appender);

our $CVSVERSION   = '$Revision: 1.12 $';
our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);

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

    my $self = {
        appender=> undef,
        key     => '_l4p',
        level   => 0,
        %options,
    };

    my @values = ();
    for my $param (qw(uid gid mode destroy key)) {
        push @values, $param, $self->{$param} if defined $self->{$param};
    }

    $self->{sem} = Log::Log4perl::Util::Semaphore->new(
        @values
    );

        # Pass back the appender to be synchronized as a dependency
        # to the configuration file parser
    push @{$options{l4p_depends_on}}, $self->{appender};

        # Run our post_init method in the configurator after
        # all appenders have been defined to make sure the
        # appender we're synchronizing really exists
    push @{$options{l4p_post_config_subs}}, sub { $self->post_init() };

    bless $self, $class;
}

###########################################
sub log {
###########################################
    my($self, %params) = @_;
    
    $self->{sem}->semlock();

    # Relay that to the SUPER class which needs to render the
    # message according to the appender's layout, first.
    $Log::Log4perl::caller_depth +=2;
    $self->{app}->SUPER::log(\%params, 
                             $params{log4p_category},
                             $params{log4p_level});
    $Log::Log4perl::caller_depth -=2;

    $self->{sem}->semunlock();
}

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

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

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

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

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

1;

__END__

=encoding utf8

=head1 NAME

    Log::Log4perl::Appender::Synchronized - Synchronizing other appenders

=head1 SYNOPSIS

    use Log::Log4perl qw(:easy);

    my $conf = qq(
    log4perl.category                   = WARN, Syncer
    
        # File appender (unsynchronized)
    log4perl.appender.Logfile           = Log::Log4perl::Appender::File
    log4perl.appender.Logfile.autoflush = 1
    log4perl.appender.Logfile.filename  = test.log
    log4perl.appender.Logfile.mode      = truncate
    log4perl.appender.Logfile.layout    = SimpleLayout
    
        # Synchronizing appender, using the file appender above
    log4perl.appender.Syncer            = Log::Log4perl::Appender::Synchronized
    log4perl.appender.Syncer.appender   = Logfile
);

    Log::Log4perl->init(\$conf);
    WARN("This message is guaranteed to be complete.");

=head1 DESCRIPTION

If multiple processes are using the same C<Log::Log4perl> appender 
without synchronization, overwrites might happen. A typical scenario
for this would be a process spawning children, each of which inherits
the parent's Log::Log4perl configuration.

In most cases, you won't need an external synchronisation tool like
Log::Log4perl::Appender::Synchronized at all. Log4perl's file appender, 
Log::Log4perl::Appender::File, for example, provides the C<syswrite>
mechanism for making sure that even long log lines won't interleave.
Short log lines won't interleave anyway, because the operating system
makes sure the line gets written before a task switch occurs.

In cases where you need additional synchronization, however, you can use
C<Log::Log4perl::Appender::Synchronized> as a gateway between your
loggers and your appenders. An appender itself, 
C<Log::Log4perl::Appender::Synchronized> just takes two additional
arguments:

=over 4

=item C<appender>

Specifies the name of the appender it synchronizes access to. The
appender specified must be defined somewhere in the configuration file,
not necessarily before the definition of 
C<Log::Log4perl::Appender::Synchronized>.

=item C<key>

This optional argument specifies the key for the semaphore that
C<Log::Log4perl::Appender::Synchronized> uses internally to ensure
atomic operations. It defaults to C<_l4p>. If you define more than
one C<Log::Log4perl::Appender::Synchronized> appender, it is 
important to specify different keys for them, as otherwise every
new C<Log::Log4perl::Appender::Synchronized> appender will nuke
previously defined semaphores. The maximum key length is four
characters, longer keys will be truncated to 4 characters -- 
C<mylongkey1> and C<mylongkey2> are interpreted to be the same:
C<mylo> (thanks to David Viner E<lt>dviner@yahoo-inc.comE<gt> for
pointing this out).

=back

C<Log::Log4perl::Appender::Synchronized> uses Log::Log4perl::Util::Semaphore
internally to perform locking with semaphores provided by the
operating system used.

=head2 Performance tips

The C<Log::Log4perl::Appender::Synchronized> serializes access to a
protected resource globally, slowing down actions otherwise performed in
parallel.

Unless specified otherwise, all instances of 
C<Log::Log4perl::Appender::Synchronized> objects in the system will
use the same global IPC key C<_l4p>.

To control access to different appender instances, it often makes sense
to define different keys for different synchronizing appenders. In this
way, Log::Log4perl serializes access to each appender instance separately:

    log4perl.category                   = WARN, Syncer1, Syncer2
    
        # File appender 1 (unsynchronized)
    log4perl.appender.Logfile1           = Log::Log4perl::Appender::File
    log4perl.appender.Logfile1.filename  = test1.log
    log4perl.appender.Logfile1.layout    = SimpleLayout
    
        # File appender 2 (unsynchronized)
    log4perl.appender.Logfile2           = Log::Log4perl::Appender::File
    log4perl.appender.Logfile2.filename  = test2.log
    log4perl.appender.Logfile2.layout    = SimpleLayout
    
        # Synchronizing appender, using the file appender above
    log4perl.appender.Syncer1            = Log::Log4perl::Appender::Synchronized
    log4perl.appender.Syncer1.appender   = Logfile1
    log4perl.appender.Syncer1.key        = l4p1

        # Synchronizing appender, using the file appender above
    log4perl.appender.Syncer2            = Log::Log4perl::Appender::Synchronized
    log4perl.appender.Syncer2.appender   = Logfile2
    log4perl.appender.Syncer2.key        = l4p2

Without the C<.key = l4p1> and C<.key = l4p2> lines, both Synchronized 
appenders would be using the default C<_l4p> key, causing unnecessary
serialization of output written to different files.

=head2 Advanced configuration

To configure the underlying Log::Log4perl::Util::Semaphore module in 
a different way than with the default settings provided by 
Log::Log4perl::Appender::Synchronized, use the following parameters:

    log4perl.appender.Syncer1.destroy  = 1
    log4perl.appender.Syncer1.mode     = sub { 0775 }
    log4perl.appender.Syncer1.uid      = hugo
    log4perl.appender.Syncer1.gid      = 100

Valid options are 
C<destroy> (Remove the semaphore on exit), 
C<mode> (permissions on the semaphore), 
C<uid> (uid or user name the semaphore is owned by), 
and
C<gid> (group id the semaphore is owned by), 

Note that C<mode> is usually given in octal and therefore needs to be
specified as a perl sub {}, unless you want to calculate what 0755 means
in decimal.

Changing ownership or group settings for a semaphore will obviously only
work if the current user ID owns the semaphore already or if the current
user is C<root>. The C<destroy> option causes the current process to 
destroy the semaphore on exit. Spawned children of the process won't
inherit this behavior.

=head2 Semaphore user and group IDs with mod_perl

Setting user and group IDs is especially important when the Synchronized
appender is used with mod_perl. If Log4perl gets initialized by a startup
handler, which runs as root, and not as the user who will later use
the semaphore, the settings for uid, gid, and mode can help establish 
matching semaphore ownership and access rights.

=head1 DEVELOPMENT NOTES

C<Log::Log4perl::Appender::Synchronized> is a I<composite> appender.
Unlike other appenders, it doesn't log any messages, it just
passes them on to its attached sub-appender.
For this reason, it doesn't need a layout (contrary to regular appenders).
If it defines none, messages are passed on unaltered.

Custom filters are also applied to the composite appender only.
They are I<not> applied to the sub-appender. Same applies to appender
thresholds. This behaviour might change in the future.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ%�XO	  O	    TestFileCreeper.pmnu �[���        ##################################################
package Log::Log4perl::Appender::TestFileCreeper;
##################################################
# Test appender, intentionally slow. It writes 
# out one byte at a time to provoke sync errors.
# Don't use it, unless for testing.
##################################################

use warnings;
use strict;

use Log::Log4perl::Appender::File;

our @ISA = qw(Log::Log4perl::Appender::File);

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

    my $fh = $self->{fh};

    for (split //, $params{message}) {
        print $fh $_;
        my $oldfh = select $self->{fh}; 
        $| = 1; 
        select $oldfh;
    }
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::TestFileCreeper - Intentionally slow test appender

=head1 SYNOPSIS

    use Log::Log4perl::Appender::TestFileCreeper;

    my $app = Log::Log4perl::Appender::TestFileCreeper->new(
      filename  => 'file.log',
      mode      => 'append',
    );

    $file->log(message => "Log me\n");

=head1 DESCRIPTION

This is a test appender, and it is intentionally slow. It writes 
out one byte at a time to provoke sync errors. Don't use it, unless 
for testing.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ���W  W  	  Socket.pmnu �[���        ##################################################
package Log::Log4perl::Appender::Socket;
##################################################
our @ISA = qw(Log::Log4perl::Appender);

use warnings;
use strict;

use IO::Socket::INET;

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

    my $self = {
        name            => "unknown name",
        silent_recovery => 0,
        no_warning      => 0,
        PeerAddr        => "localhost",
        Proto           => 'tcp',
        Timeout         => 5,
        @options,
    };

    bless $self, $class;

    unless ($self->{defer_connection}){
        unless($self->connect(@options)) {
            if($self->{silent_recovery}) {
                if( ! $self->{no_warning}) {
                    warn "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
                }
               return $self;
            }
            die "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
        }

        $self->{socket}->autoflush(1); 
        #autoflush has been the default behavior since 1997
    }

    return $self;
}
    
##################################################
sub connect {
##################################################
    my($self, @options) = @_;

    $self->{socket} = IO::Socket::INET->new(@options);

    return $self->{socket};
}

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


    {
            # If we were never able to establish
            # a connection, try to establish one 
            # here. If it fails, return.
        if(($self->{silent_recovery} or $self->{defer_connection}) and 
           !defined $self->{socket}) {
            if(! $self->connect(%$self)) {
                return undef;
            }
        }
  
            # Try to send the message across
        eval { $self->{socket}->send($params{message}); 
             };

        if($@) {
            warn "Send to " . ref($self) . " failed ($@), retrying once...";
            if($self->connect(%$self)) {
                redo;
            }
            if($self->{silent_recovery}) {
                return undef;
            }
            warn "Reconnect to $self->{PeerAddr}:$self->{PeerPort} " .
                 "failed: $!";
            return undef;
        }
    };

    return 1;
}

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

    undef $self->{socket};
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::Socket - Log to a socket

=head1 SYNOPSIS

    use Log::Log4perl::Appender::Socket;

    my $appender = Log::Log4perl::Appender::Socket->new(
      PeerAddr => "server.foo.com",
      PeerPort => 1234,
    );

    $appender->log(message => "Log me\n");

=head1 DESCRIPTION

This is a simple appender for writing to a socket. It relies on
L<IO::Socket::INET> and offers all parameters this module offers.

Upon destruction of the object, pending messages will be flushed
and the socket will be closed.

If the appender cannot contact the server during the initialization
phase (while running the constructor C<new>), it will C<die()>.

If the appender fails to log a message because the socket's C<send()>
method fails (most likely because the server went down), it will
try to reconnect once. If it succeeds, the message will be sent.
If the reconnect fails, a warning is sent to STDERR and the C<log()>
method returns, discarding the message.

If the option C<silent_recovery> is given to the constructor and
set to a true value, the behaviour is different: If the socket connection
can't be established at initialization time, a single warning is issued.
Every log attempt will then try to establish the connection and 
discard the message silently if it fails.
If you don't even want the warning, set the C<no_warning> option to
a true value.

Connecting at initialization time may not be the best option when
running under Apache1 Apache2/prefork, because the parent process creates
the socket and the connections are shared among the forked children--all
the children writing to the same socket could intermingle messages.  So instead
of that, you can use C<defer_connection> which will put off making the
connection until the first log message is sent.

=head1 EXAMPLE

Write a server quickly using the IO::Socket::INET module:

    use IO::Socket::INET;

    my $sock = IO::Socket::INET->new(
        Listen    => 5,
        LocalAddr => 'localhost',
        LocalPort => 12345,
        Proto     => 'tcp');

    while(my $client = $sock->accept()) {
        print "Client connected\n";
        while(<$client>) {
            print "$_\n";
        }
    }

Start it and then run the following script as a client:

    use Log::Log4perl qw(:easy);

    my $conf = q{
        log4perl.category                  = WARN, Socket
        log4perl.appender.Socket           = Log::Log4perl::Appender::Socket
        log4perl.appender.Socket.PeerAddr  = localhost
        log4perl.appender.Socket.PeerPort  = 12345
        log4perl.appender.Socket.layout    = SimpleLayout
    };

    Log::Log4perl->init(\$conf);

    sleep(2);

    for(1..10) {
        ERROR("Quack!");
        sleep(5);
    }

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ_�8�   �   	  Buffer.pmnu �[���        ######################################################################
# Buffer.pm -- 2004, Mike Schilli <m@perlmeister.com>
######################################################################
# Composite appender buffering messages until a trigger condition is met.
######################################################################

###########################################
package Log::Log4perl::Appender::Buffer;
###########################################

use strict;
use warnings;

our @ISA = qw(Log::Log4perl::Appender);

our $CVSVERSION   = '$Revision: 1.2 $';
our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);

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

    my $self = {
        appender=> undef,
        buffer  => [],
        options => { 
            max_messages  => undef, 
            trigger       => undef,
            trigger_level => undef,
        },
        level   => 0,
        %options,
    };

    if($self->{trigger_level}) {
        $self->{trigger} = level_trigger($self->{trigger_level});
    }

        # Pass back the appender to be synchronized as a dependency
        # to the configuration file parser
    push @{$options{l4p_depends_on}}, $self->{appender};

        # Run our post_init method in the configurator after
        # all appenders have been defined to make sure the
        # appender we're playing 'dam' for really exists
    push @{$options{l4p_post_config_subs}}, sub { $self->post_init() };

    bless $self, $class;
}

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

    local $Log::Log4perl::caller_depth =
        $Log::Log4perl::caller_depth + 2;

        # Do we need to discard a message because there's already
        # max_size messages in the buffer?
    if(defined $self->{max_messages} and
       @{$self->{buffer}} == $self->{max_messages}) {
        shift @{$self->{buffer}};
    }
        # Ask the appender to save a cached message in $cache
    $self->{app}->SUPER::log(\%params,
                         $params{log4p_category},
                         $params{log4p_level}, \my $cache);

        # Save it in the appender's message buffer, but only if
        # it hasn't been suppressed by an appender threshold
    if( defined $cache ) {
        push @{ $self->{buffer} }, $cache;
    }

    $self->flush() if $self->{trigger}->($self, \%params);
}

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

        # Flush pending messages if we have any
    for my $cache (@{$self->{buffer}}) {
        $self->{app}->SUPER::log_cached($cache);
    }

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

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

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

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

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

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

###########################################
sub level_trigger {
###########################################
    my($level) = @_;

        # closure holding $level
    return sub {
        my($self, $params) = @_;

        return Log::Log4perl::Level::to_priority(
                 $params->{log4p_level}) >= 
               Log::Log4perl::Level::to_priority($level);
    };
}
    
###########################################
sub DESTROY {
###########################################
    my($self) = @_;
}

1;

__END__

=encoding utf8

=head1 NAME

    Log::Log4perl::Appender::Buffer - Buffering Appender

=head1 SYNOPSIS

    use Log::Log4perl qw(:easy);

    my $conf = qq(
    log4perl.category                  = DEBUG, Buffer

        # Regular Screen Appender
    log4perl.appender.Screen           = Log::Log4perl::Appender::Screen
    log4perl.appender.Screen.stdout    = 1
    log4perl.appender.Screen.layout    = PatternLayout
    log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n

        # Buffering appender, using the appender above as outlet
    log4perl.appender.Buffer               = Log::Log4perl::Appender::Buffer
    log4perl.appender.Buffer.appender      = Screen
    log4perl.appender.Buffer.trigger_level = ERROR
    );

    Log::Log4perl->init(\$conf);

    DEBUG("This message gets buffered.");
    INFO("This message gets buffered also.");

    # Time passes. Nothing happens. But then ...

    print "It's GO time!!!\n";

    ERROR("This message triggers a buffer flush.");

=head1 DESCRIPTION

C<Log::Log4perl::Appender::Buffer> takes these arguments:

=over 4

=item C<appender>

Specifies the name of the appender it buffers messages for. The
appender specified must be defined somewhere in the configuration file,
not necessarily before the definition of 
C<Log::Log4perl::Appender::Buffer>.

=item C<max_messages>

Specifies the maximum number of messages the appender will hold in
its ring buffer. C<max_messages> is optional. By default,
C<Log::Log4perl::Appender::Buffer> will I<not> limit the number of
messages buffered. This might be undesirable in long-running processes
accumulating lots of messages before a flush happens. If
C<max_messages> is set to a numeric value,
C<Log::Log4perl::Appender::Buffer> will displace old messages in its
buffer to make room if the buffer is full.

=item C<trigger_level>

If trigger_level is set to one of Log4perl's levels (see
Log::Log4perl::Level), a C<trigger> function will be defined internally
to flush the buffer if a message with a priority of $level or higher
comes along. This is just a convenience function. Defining

    log4perl.appender.Buffer.trigger_level = ERROR

is equivalent to creating a trigger function like

    log4perl.appender.Buffer.trigger = sub {   \
        my($self, $params) = @_;               \
        return $params->{log4p_level} >=       \
               $Log::Log4perl::Level::ERROR; }

See the next section for defining generic trigger functions.

=item C<trigger>

C<trigger> holds a reference to a subroutine, which
C<Log::Log4perl::Appender::Buffer> will call on every incoming message
with the same parameters as the appender's C<log()> method:

        my($self, $params) = @_;

C<$params> references a hash containing
the message priority (key C<l4p_level>), the
message category (key C<l4p_category>) and the content of the message
(key C<message>).

If the subroutine returns 1, it will trigger a flush of buffered messages.

Shortcut 

=back

=head1 DEVELOPMENT NOTES

C<Log::Log4perl::Appender::Buffer> is a I<composite> appender.
Unlike other appenders, it doesn't log any messages, it just
passes them on to its attached sub-appender.
For this reason, it doesn't need a layout (contrary to regular appenders).
If it defines none, messages are passed on unaltered.

Custom filters are also applied to the composite appender only.
They are I<not> applied to the sub-appender. Same applies to appender
thresholds. This behaviour might change in the future.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ��so
  o
    TestArrayBuffer.pmnu �[���        ##################################################
package Log::Log4perl::Appender::TestArrayBuffer;
##################################################
# Like Log::Log4perl::Appender::TestBuffer, just with 
# array capability.
# For testing only.
##################################################

use base qw( Log::Log4perl::Appender::TestBuffer );

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

    $self->{buffer} .= "[$params{level}]: " if $LOG_PRIORITY;

    if(ref($params{message}) eq "ARRAY") {
        $self->{buffer} .= "[" . join(',', @{$params{message}}) . "]";
    } else {
        $self->{buffer} .= $params{message};
    }
}

1;

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::TestArrayBuffer - Subclass of Appender::TestBuffer

=head1 SYNOPSIS

  use Log::Log4perl::Appender::TestArrayBuffer;

  my $appender = Log::Log4perl::Appender::TestArrayBuffer->new( 
      name      => 'buffer',
  );

      # Append to the buffer
  $appender->log( 
      level =  > 'alert', 
      message => ['first', 'second', 'third'],
  );

      # Retrieve the result
  my $result = $appender->buffer();

      # Reset the buffer to the empty string
  $appender->reset();

=head1 DESCRIPTION

This class is a subclass of Log::Log4perl::Appender::TestBuffer and
just provides message array refs as an additional feature. 

Just like Log::Log4perl::Appender::TestBuffer, 
Log::Log4perl::Appender::TestArrayBuffer is used for internal
Log::Log4perl testing only.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ�!�y�  �    RRDs.pmnu �[���        ##################################################
package Log::Log4perl::Appender::RRDs;
##################################################
our @ISA = qw(Log::Log4perl::Appender);

use warnings;
use strict;
use RRDs;

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

    my $self = {
        name             => "unknown name",
        dbname           => undef,
        rrdupd_params => [],
        @options,
    };

    die "Mandatory parameter 'dbname' missing" unless
        defined $self->{dbname};

    bless $self, $class;

    return $self;
}

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

    #print "UPDATE: '$self->{dbname}' - '$params{message}'\n";

    RRDs::update($self->{dbname}, 
                 @{$params{rrdupd_params}},
                 $params{message}) or
        die "Cannot update rrd $self->{dbname} ",
            "with $params{message} ($!)";
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::RRDs - Log to a RRDtool Archive
    
=head1 SYNOPSIS
    
    use Log::Log4perl qw(get_logger);
    use RRDs;
    
    my $DB = "myrrddb.dat";
    
    RRDs::create(
      $DB, "--step=1",
      "DS:myvalue:GAUGE:2:U:U",
      "RRA:MAX:0.5:1:120");
    
    print time(), "\n";
    
    Log::Log4perl->init(\qq{
      log4perl.category = INFO, RRDapp
      log4perl.appender.RRDapp = Log::Log4perl::Appender::RRDs
      log4perl.appender.RRDapp.dbname = $DB
      log4perl.appender.RRDapp.layout = Log::Log4perl::Layout::PatternLayout
      log4perl.appender.RRDapp.layout.ConversionPattern = N:%m
    });
    
    my $logger = get_logger();
    
    for(10, 15, 20, 25) {
        $logger->info($_);
        sleep 1;
    }
   
=head1 DESCRIPTION

C<Log::Log4perl::Appender::RRDs> appenders facilitate writing data
to RRDtool round-robin archives via Log4perl. For documentation
on RRD and its Perl interface C<RRDs> (which comes with the distribution),
check out L<http://rrdtool.org>.

Messages sent to Log4perl's RRDs appender are expected to be numerical values
(ints or floats), which then are used to run a C<rrdtool update> command
on an existing round-robin database. The name of this database needs to
be set in the appender's C<dbname> configuration parameter.

If there's more parameters you wish to pass to the C<update> method,
use the C<rrdupd_params> configuration parameter:

    log4perl.appender.RRDapp.rrdupd_params = --template=in:out

To read out the round robin database later on, use C<rrdtool fetch>
or C<rrdtool graph> for graphic displays.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ�s'�  �    TestBuffer.pmnu �[���        package Log::Log4perl::Appender::TestBuffer;
our @ISA = qw(Log::Log4perl::Appender);

##################################################
# Log dispatcher writing to a string buffer
# For testing.
# This is like having a Log::Log4perl::Appender::TestBuffer
##################################################

our %POPULATION       = ();
our $LOG_PRIORITY     = 0;
our $DESTROY_MESSAGES = "";

##################################################
sub new {
##################################################
    my $proto  = shift;
    my $class  = ref $proto || $proto;
    my %params = @_;

    my $self = {
        name      => "unknown name",
        %params,
    };

    bless $self, $class;

    $self->{stderr} = exists $params{stderr} ? $params{stderr} : 1;
    $self->{buffer} = "";

    $POPULATION{$self->{name}} = $self;

    return $self;
}

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

    if( !defined $params{level} ) {
        die "No level defined in log() call of " . __PACKAGE__;
    }
    $self->{buffer} .= "[$params{level}]: " if $LOG_PRIORITY;
    $self->{buffer} .= $params{message};
}

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

    $self->{buffer} = "";
}

##################################################
sub buffer {   
##################################################
    my($self, $new) = @_;

    if(defined $new) {
        $self->{buffer} = $new;
    }

    return $self->{buffer};
}

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

    %POPULATION = ();
    $self->{buffer} = "";
}

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

    $DESTROY_MESSAGES .= __PACKAGE__ . " destroyed";

    #this delete() along with &reset() above was causing
    #Attempt to free unreferenced scalar at 
    #blib/lib/Log/Log4perl/TestBuffer.pm line 69.
    #delete $POPULATION{$self->name};
}

##################################################
sub by_name {   
##################################################
    my($self, $name) = @_;

    # Return a TestBuffer by appender name. This is useful if
    # test buffers are created behind our back (e.g. via the
    # Log4perl config file) and later on we want to 
    # retrieve an instance to query its content.

    die "No name given"  unless defined $name;

    return $POPULATION{$name};

}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::TestBuffer - Appender class for testing

=head1 SYNOPSIS

  use Log::Log4perl::Appender::TestBuffer;

  my $appender = Log::Log4perl::Appender::TestBuffer->new( 
      name      => 'mybuffer',
  );

      # Append to the buffer
  $appender->log( 
      level =  > 'alert', 
      message => "I'm searching the city for sci-fi wasabi\n" 
  );

      # Retrieve the result
  my $result = $appender->buffer();

      # Clear the buffer to the empty string
  $appender->clear();

=head1 DESCRIPTION

This class is used for internal testing of C<Log::Log4perl>. It
is a C<Log::Dispatch>-style appender, which writes to a buffer 
in memory, from where actual results can be easily retrieved later
to compare with expeced results.

Every buffer created is stored in an internal global array, and can
later be referenced by name:

    my $app = Log::Log4perl::Appender::TestBuffer->by_name("mybuffer");

retrieves the appender object of a previously created buffer "mybuffer".
To reset this global array and have it forget all of the previously 
created testbuffer appenders (external references to those appenders
nonwithstanding), use

    Log::Log4perl::Appender::TestBuffer->reset();

=head1 SEE ALSO

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ���
  �
  	  String.pmnu �[���        package Log::Log4perl::Appender::String;
our @ISA = qw(Log::Log4perl::Appender);

##################################################
# Log dispatcher writing to a string buffer
##################################################

##################################################
sub new {
##################################################
    my $proto  = shift;
    my $class  = ref $proto || $proto;
    my %params = @_;

    my $self = {
        name      => "unknown name",
        string    => "",
        %params,
    };

    bless $self, $class;
}

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

    $self->{string} .= $params{message};
}

##################################################
sub string {   
##################################################
    my($self, $new) = @_;

    if(defined $new) {
        $self->{string} = $new;
    }

    return $self->{string};
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::String - Append to a string

=head1 SYNOPSIS

  use Log::Log4perl::Appender::String;

  my $appender = Log::Log4perl::Appender::String->new( 
      name      => 'my string appender',
  );

      # Append to the string
  $appender->log( 
      message => "I'm searching the city for sci-fi wasabi\n" 
  );

      # Retrieve the result
  my $result = $appender->string();

      # Reset the buffer to the empty string
  $appender->string("");

=head1 DESCRIPTION

This is a simple appender used internally by C<Log::Log4perl>. It
appends messages to a scalar instance variable.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ!h�t|;  |;    File.pmnu �[���        ##################################################
package Log::Log4perl::Appender::File;
##################################################

our @ISA = qw(Log::Log4perl::Appender);

use warnings;
use strict;
use Log::Log4perl::Config::Watch;
use Fcntl;
use constant _INTERNAL_DEBUG => 0;

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

    my $self = {
        name      => "unknown name",
        umask     => undef,
        owner     => undef,
        group     => undef,
        autoflush => 1,
        syswrite  => 0,
        mode      => "append",
        binmode   => undef,
        utf8      => undef,
        recreate  => 0,
        recreate_check_interval => 30,
        recreate_check_signal   => undef,
        recreate_pid_write      => undef,
        create_at_logtime       => 0,
        header_text             => undef,
        @options,
    };

    if($self->{create_at_logtime}) {
        $self->{recreate}  = 1;
    }

    if(defined $self->{umask} and $self->{umask} =~ /^0/) {
            # umask value is a string, meant to be an oct value
        $self->{umask} = oct($self->{umask});
    }

    die "Mandatory parameter 'filename' missing" unless
        exists $self->{filename};

    bless $self, $class;

    if($self->{recreate_pid_write}) {
        print "Creating pid file",
              " $self->{recreate_pid_write}\n" if _INTERNAL_DEBUG;
        open FILE, ">$self->{recreate_pid_write}" or 
            die "Cannot open $self->{recreate_pid_write}";
        print FILE "$$\n";
        close FILE;
    }

        # This will die() if it fails
    $self->file_open() unless $self->{create_at_logtime};

    return $self;
}

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

    return $self->{filename};
}

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

    my $arrows  = ">";
    my $sysmode = (O_CREAT|O_WRONLY);

    my $old_umask = umask();

    if($self->{mode} eq "append") {
        $arrows   = ">>";
        $sysmode |= O_APPEND;
    } elsif ($self->{mode} eq "pipe") {
        $arrows = "|";
    } else {
        $sysmode |= O_TRUNC;
    }

    my $fh = do { local *FH; *FH; };

    umask($self->{umask}) if defined $self->{umask};

    my $didnt_exist = ! -e $self->{filename};

    if($self->{syswrite}) {
        sysopen $fh, "$self->{filename}", $sysmode or
            die "Can't sysopen $self->{filename} ($!)";
    } else {
        open $fh, "$arrows$self->{filename}" or
            die "Can't open $self->{filename} ($!)";
    }

    if($didnt_exist and 
         ( defined $self->{owner} or defined $self->{group} )
      ) {

        eval { $self->perms_fix() };

        if($@) {
              # Cleanup and re-throw
            unlink $self->{filename};
            die $@;
        }
    }

    if($self->{recreate}) {
        $self->{watcher} = Log::Log4perl::Config::Watch->new(
            file           => $self->{filename},
            (defined $self->{recreate_check_interval} ?
              (check_interval => $self->{recreate_check_interval}) : ()),
            (defined $self->{recreate_check_signal} ?
              (signal => $self->{recreate_check_signal}) : ()),
        );
    }

    umask($old_umask) if defined $self->{umask};

    $self->{fh} = $fh;

    if ($self->{autoflush} and ! $self->{syswrite}) {
        my $oldfh = select $self->{fh}; 
        $| = 1; 
        select $oldfh;
    }

    if (defined $self->{binmode}) {
        binmode $self->{fh}, $self->{binmode};
    }

    if (defined $self->{utf8}) {
        binmode $self->{fh}, ":utf8";
    }

    if(defined $self->{header_text}) {
        if( $self->{header_text} !~ /\n\Z/ ) {
            $self->{header_text} .= "\n";
        }
        my $fh = $self->{fh};
        print $fh $self->{header_text};
    }
}

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

    if(defined $self->{fh}) {
        $self->close_with_care( $self->{ fh } );
    }

    undef $self->{fh};
}

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

    my ($uid_org, $gid_org) = (stat $self->{filename})[4,5];

    my ($uid, $gid) = ($uid_org, $gid_org);

    if(!defined $uid) {
        die "stat of $self->{filename} failed ($!)";
    }

    my $needs_fixing = 0;

    if(defined $self->{owner}) {
        $uid = $self->{owner};
        if($self->{owner} !~ /^\d+$/) {
            $uid = (getpwnam($self->{owner}))[2];
            die "Unknown user: $self->{owner}" unless defined $uid;
        }
    }

    if(defined $self->{group}) {
        $gid = $self->{group};
        if($self->{group} !~ /^\d+$/) {
            $gid = getgrnam($self->{group});

            die "Unknown group: $self->{group}" unless defined $gid;
        }
    }
    if($uid != $uid_org or $gid != $gid_org) {
        chown($uid, $gid, $self->{filename}) or 
            die "chown('$uid', '$gid') on '$self->{filename}' failed: $!";
    }
}

##################################################
sub file_switch {
##################################################
    my($self, $new_filename) = @_;

    print "Switching file from $self->{filename} to $new_filename\n" if
        _INTERNAL_DEBUG;

    $self->file_close();
    $self->{filename} = $new_filename;
    $self->file_open();
}

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

    if($self->{recreate}) {
        if($self->{recreate_check_signal}) {
            if(!$self->{watcher} or
               $self->{watcher}->{signal_caught}) {
                $self->file_switch($self->{filename});
                $self->{watcher}->{signal_caught} = 0;
            }
        } else {
            if(!$self->{watcher} or
                $self->{watcher}->file_has_moved()) {
                $self->file_switch($self->{filename});
            }
        }
    }

    my $fh = $self->{fh};

    if($self->{syswrite}) {
       defined (syswrite $fh, $params{message}) or
           die "Cannot syswrite to '$self->{filename}': $!";
    } else {
        print $fh $params{message} or
            die "Cannot write to '$self->{filename}': $!";
    }
}

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

    if ($self->{fh}) {
        my $fh = $self->{fh};
        $self->close_with_care( $fh );
    }
}

###########################################
sub close_with_care {
###########################################
    my( $self, $fh ) = @_;

    my $prev_rc = $?;

    my $rc = close $fh;

      # [rt #84723] If a sig handler is reaping the child generated
      # by close() internally before close() gets to it, it'll
      # result in a weird (but benign) error that we don't want to
      # expose to the user.
    if( !$rc ) {
        if( $self->{ mode } eq "pipe" and 
            $!{ ECHILD } ) {
            if( $Log::Log4perl::CHATTY_DESTROY_METHODS ) {
                warn "$$: pipe closed with ECHILD error -- guess that's ok";
            }
            $? = $prev_rc;
        } else {
            warn "Can't close $self->{filename} ($!)";
        }
    }

    return $rc;
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::File - Log to file

=head1 SYNOPSIS

    use Log::Log4perl::Appender::File;

    my $app = Log::Log4perl::Appender::File->new(
      filename  => 'file.log',
      mode      => 'append',
      autoflush => 1,
      umask     => 0222,
    );

    $file->log(message => "Log me\n");

=head1 DESCRIPTION

This is a simple appender for writing to a file.

The C<log()> method takes a single scalar. If a newline character
should terminate the message, it has to be added explicitely.

Upon destruction of the object, the filehandle to access the
file is flushed and closed.

If you want to switch over to a different logfile, use the
C<file_switch($newfile)> method which will first close the old
file handle and then open a one to the new file specified.

=head2 OPTIONS

=over 4

=item filename

Name of the log file.

=item mode

Messages will be append to the file if C<$mode> is set to the
string C<"append">. Will clobber the file
if set to C<"clobber">. If it is C<"pipe">, the file will be understood 
as executable to pipe output to. Default mode is C<"append">.

=item autoflush

C<autoflush>, if set to a true value, triggers flushing the data
out to the file on every call to C<log()>. C<autoflush> is on by default.

=item syswrite

C<syswrite>, if set to a true value, makes sure that the appender uses
syswrite() instead of print() to log the message. C<syswrite()> usually
maps to the operating system's C<write()> function and makes sure that
no other process writes to the same log file while C<write()> is busy.
Might safe you from having to use other syncronisation measures like
semaphores (see: Synchronized appender).

=item umask

Specifies the C<umask> to use when creating the file, determining
the file's permission settings. 
If set to C<0222> (default), new
files will be created with C<rw-r--r--> permissions.
If set to C<0000>, new files will be created with C<rw-rw-rw-> permissions.

=item owner

If set, specifies that the owner of the newly created log file should
be different from the effective user id of the running process.
Only makes sense if the process is running as root. 
Both numerical user ids and user names are acceptable.
Log4perl does not attempt to change the ownership of I<existing> files.

=item group

If set, specifies that the group of the newly created log file should
be different from the effective group id of the running process.
Only makes sense if the process is running as root.
Both numerical group ids and group names are acceptable.
Log4perl does not attempt to change the group membership of I<existing> files.

=item utf8

If you're printing out Unicode strings, the output filehandle needs
to be set into C<:utf8> mode:

    my $app = Log::Log4perl::Appender::File->new(
      filename  => 'file.log',
      mode      => 'append',
      utf8      => 1,
    );

=item binmode

To manipulate the output filehandle via C<binmode()>, use the
binmode parameter:

    my $app = Log::Log4perl::Appender::File->new(
      filename  => 'file.log',
      mode      => 'append',
      binmode   => ":utf8",
    );

A setting of ":utf8" for C<binmode> is equivalent to specifying
the C<utf8> option (see above).

=item recreate

Normally, if a file appender logs to a file and the file gets moved to
a different location (e.g. via C<mv>), the appender's open file handle
will automatically follow the file to the new location.

This may be undesirable. When using an external logfile rotator, 
for example, the appender should create a new file under the old name
and start logging into it. If the C<recreate> option is set to a true value, 
C<Log::Log4perl::Appender::File> will do exactly that. It defaults to 
false. Check the C<recreate_check_interval> option for performance 
optimizations with this feature.

=item recreate_check_interval

In C<recreate> mode, the appender has to continuously check if the
file it is logging to is still in the same location. This check is
fairly expensive, since it has to call C<stat> on the file name and
figure out if its inode has changed. Doing this with every call
to C<log> can be prohibitively expensive. Setting it to a positive
integer value N will only check the file every N seconds. It defaults to 30.

This obviously means that the appender will continue writing to 
a moved file until the next check occurs, in the worst case
this will happen C<recreate_check_interval> seconds after the file
has been moved or deleted. If this is undesirable,
setting C<recreate_check_interval> to 0 will have the
appender check the file with I<every> call to C<log()>.

=item recreate_check_signal

In C<recreate> mode, if this option is set to a signal name
(e.g. "USR1"), the appender will recreate a missing logfile
when it receives the signal. It uses less resources than constant
polling. The usual limitation with perl's signal handling apply.
Check the FAQ for using this option with the log rotating 
utility C<newsyslog>.

=item recreate_pid_write

The popular log rotating utility C<newsyslog> expects a pid file
in order to send the application a signal when its logs have
been rotated. This option expects a path to a file where the pid
of the currently running application gets written to.
Check the FAQ for using this option with the log rotating 
utility C<newsyslog>.

=item create_at_logtime

The file appender typically creates its logfile in its constructor, i.e. 
at Log4perl C<init()> time. This is desirable for most use cases, because
it makes sure that file permission problems get detected right away, and 
not after days/weeks/months of operation when the appender suddenly needs
to log something and fails because of a problem that was obvious at
startup.

However, there are rare use cases where the file shouldn't be created
at Log4perl C<init()> time, e.g. if the appender can't be used by the current
user although it is defined in the configuration file. If you set
C<create_at_logtime> to a true value, the file appender will try to create
the file at log time. Note that this setting lets permission problems
sit undetected until log time, which might be undesirable.

=item header_text

If you want Log4perl to print a header into every newly opened
(or re-opened) logfile, set C<header_text> to either a string
or a subroutine returning a string. If the message doesn't have a newline,
a newline at the end of the header will be provided.

=back

Design and implementation of this module has been greatly inspired by
Dave Rolsky's C<Log::Dispatch> appender framework.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �&jZ���0JN  JN    DBI.pmnu �[���        package Log::Log4perl::Appender::DBI;

our @ISA = qw(Log::Log4perl::Appender);

use Carp;

use strict;
use DBI;

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,
    );

    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}},
                   undef_column_value => undef,
                });
    }
    #'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; 

    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}},
            undef_column_value => undef,
        });
    }

    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 _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, $params{attrs} ? %{$params{attrs}} : ()})
                            or croak "Log4perl: $DBI::errstr";
        };
        $self->{dbh} = $self->{connect}->();
        $self->{_mine} = 1;
    }
}

sub create_statement {
    my ($self, $stmt) = @_;

    $stmt || croak "Log4perl: sql not set in Log4perl::Appender::DBI";

    return $self->{dbh}->prepare($stmt) || croak "Log4perl: DBI->prepare failed $DBI::errstr\n$stmt";

}


sub log {
    my $self = shift;
    my %p = @_;

    #%p is
    #    { name    => $appender_name,
    #      level   => loglevel
    #      message => $message,
    #      log4p_category => $category,
    #      log4p_level  => $level,);
    #    },

        #getting log4j behavior with no specified ConversionPattern
    chomp $p{message} unless ref $p{message}; 

        
    my $qmarks = $self->calculate_bind_values(\%p);


    if ($self->{usePreparedStmt}) {

        $self->query_execute($self->{sth}, @$qmarks);

    }else{

        #first expand any %x's in the statement
        my $stmt = $self->{layout}->render(
                        $p{message},
                        $p{log4p_category},
                        $p{log4p_level},
                        5 + $Log::Log4perl::caller_depth,  
                        );

        push @{$self->{BUFFER}}, $stmt, $qmarks;

        $self->check_buffer();
    }
}

sub query_execute {
    my($self, $sth, @qmarks) = @_;

    my $errstr = "[no error]";

    for my $attempt (0..$self->{reconnect_attempts}) {
        #warn "Exe: @qmarks"; # TODO
        if(! $sth->execute(@qmarks)) {

                  # save errstr because ping() would override it [RT 56145]
                $errstr = $self->{dbh}->errstr();

                # Exe failed -- was it because we lost the DB
                # connection?
                if($self->{dbh}->ping()) {
                    # No, the connection is ok, we failed because there's
                    # something wrong with the execute(): Bad SQL or 
                    # missing parameters or some such). Abort.
                    croak "Log4perl: DBI appender error: '$errstr'";
                }

                if($attempt == $self->{reconnect_attempts}) {
                    croak "Log4perl: DBI appender failed to " .
                          ($self->{reconnect_attempts} == 1 ? "" : "re") .
                          "connect " .
                          "to database after " .
                          "$self->{reconnect_attempts} attempt" .
                          ($self->{reconnect_attempts} == 1 ? "" : "s") .
                          " (last error error was [$errstr]";
                }
            if(! $self->{dbh}->ping()) {
                # Ping failed, try to reconnect
                if($attempt) {
                    #warn "Sleeping"; # TODO
                    sleep($self->{reconnect_sleep}) if $self->{reconnect_sleep};
                }

                eval {
                    #warn "Reconnecting to DB"; # TODO
                    $self->{dbh} = $self->{connect}->();
                };
            }

            if ($self->{usePreparedStmt}) {
                $sth = $self->create_statement($self->{SQL});
                $self->{sth} = $sth if $self->{sth};
            } else {
                #warn "Pending stmt: $self->{pending_stmt}"; #TODO
                $sth = $self->create_statement($self->{pending_stmt});
            }

            next;
        }
        return 1;
    }
    croak "Log4perl: DBI->execute failed $errstr, \n".
          "on $self->{SQL}\n @qmarks";
}

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

    my @qmarks;
    my $user_ph_idx = 0;

    my $i=0;
    
    if ($self->{bind_value_layouts}) {

        my $prev_pnum = 0;
        my $max_pnum = 0;
    
        my @pnums = sort {$a <=> $b} keys %{$self->{bind_value_layouts}};
        $max_pnum = $pnums[-1];
        
        #Walk through the integers for each possible bind value.
        #If it doesn't have a layout assigned from the config file
        #then shift it off the array from the $log call
        #This needs to be reworked now that we always get an arrayref? --kg 1/2003
        foreach my $pnum (1..$max_pnum){
            my $msg;
    
                #we've got a bind_value_layout to fill the spot
            if ($self->{bind_value_layouts}{$pnum}){
               $msg = $self->{bind_value_layouts}{$pnum}->render(
                        $p->{message},
                        $p->{log4p_category},
                        $p->{log4p_level},
                        5 + $Log::Log4perl::caller_depth,  
                    );

               #we don't have a bind_value_layout, so get
               #a message bit
            }elsif (ref $p->{message} eq 'ARRAY' && @{$p->{message}}){
                #$msg = shift @{$p->{message}};
                $msg = $p->{message}->[$i++];

               #here handle cases where we ran out of message bits
               #before we ran out of bind_value_layouts, just keep going
            }elsif (ref $p->{message} eq 'ARRAY'){
                $msg = undef;
                $p->{message} = undef;

               #here handle cases where we didn't get an arrayref
               #log the message in the first placeholder and nothing in the rest
            }elsif (! ref $p->{message} ){
                $msg = $p->{message};
                $p->{message} = undef;

            }

            if ($self->{MAX_COL_SIZE} &&
                length($msg) > $self->{MAX_COL_SIZE}){
                substr($msg, $self->{MAX_COL_SIZE}) = '';
            }
            push @qmarks, $msg;
        }
    }

    #handle leftovers
    if (ref $p->{message} eq 'ARRAY' && @{$p->{message}} ) {
        #push @qmarks, @{$p->{message}};
        push @qmarks, @{$p->{message}}[$i..@{$p->{message}}-1];

    }

    return \@qmarks;
}


sub check_buffer {
    my $self = shift;

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

    if (scalar @{$self->{BUFFER}} >= $self->{BUFFERSIZE} * 2) {

        my ($sth, $stmt, $prev_stmt);

        $prev_stmt = ""; # Init to avoid warning (ms 5/10/03)

        while (@{$self->{BUFFER}}) {
            my ($stmt, $qmarks) = splice (@{$self->{BUFFER}},0,2);

            $self->{pending_stmt} = $stmt;

                #reuse the sth if the stmt doesn't change
            if ($stmt ne $prev_stmt) {
                $sth->finish if $sth;
                $sth = $self->create_statement($stmt);
            }

            $self->query_execute($sth, @$qmarks);

            $prev_stmt = $stmt;

        }

        $sth->finish;

        my $dbh = $self->{dbh};

        if ($dbh && ! $dbh->{AutoCommit}) {
            $dbh->commit;
        }
    }
}

sub DESTROY {
    my $self = shift;

    $self->{BUFFERSIZE} = 1;

    $self->check_buffer();

    if ($self->{_mine} && $self->{dbh}) {
        $self->{dbh}->disconnect;
    }
}


1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Appender::DBI - implements appending to a DB

=head1 SYNOPSIS

    my $config = q{
     log4j.category = WARN, DBAppndr
     log4j.appender.DBAppndr             = Log::Log4perl::Appender::DBI
     log4j.appender.DBAppndr.datasource  = DBI:CSV:f_dir=t/tmp
     log4j.appender.DBAppndr.username    = bobjones
     log4j.appender.DBAppndr.password    = 12345
     log4j.appender.DBAppndr.sql         = \
        insert into log4perltest           \
        (loglevel, custid, category, message, ipaddr) \
        values (?,?,?,?,?)
     log4j.appender.DBAppndr.params.1 = %p    
                                   #2 is custid from the log() call
     log4j.appender.DBAppndr.params.3 = %c
                                   #4 is the message from log()
                                   #5 is ipaddr from log()

     log4j.appender.DBAppndr.usePreparedStmt = 1
      #--or--
     log4j.appender.DBAppndr.bufferSize = 2

     #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

     #driver attributes support
     log4j.appender.DBAppndr.attrs.f_encoding = utf8
    };

    $logger->warn( $custid, 'big problem!!', $ip_addr );

=head1 CAVEAT

This is a very young module and there are a lot of variations
in setups with different databases and connection methods,
so make sure you test thoroughly!  Any feedback is welcome!

=head1 DESCRIPTION

This is a specialized Log::Dispatch object customized to work with
log4perl and its abilities, originally based on Log::Dispatch::DBI 
by Tatsuhiko Miyagawa but with heavy modifications.

It is an attempted compromise between what Log::Dispatch::DBI was 
doing and what log4j's JDBCAppender does.  Note the log4j docs say
the JDBCAppender "is very likely to be completely replaced in the future."

The simplest usage is this:

    log4j.category = WARN, DBAppndr
    log4j.appender.DBAppndr            = Log::Log4perl::Appender::DBI
    log4j.appender.DBAppndr.datasource = DBI:CSV:f_dir=t/tmp
    log4j.appender.DBAppndr.username   = bobjones
    log4j.appender.DBAppndr.password   = 12345
    log4j.appender.DBAppndr.sql        = \
       INSERT INTO logtbl                \
          (loglevel, message)            \
          VALUES ('%c','%m')

    log4j.appender.DBAppndr.layout    = Log::Log4perl::Layout::PatternLayout


    $logger->fatal('fatal message');
    $logger->warn('warning message');

    ===============================
    |FATAL|fatal message          |
    |WARN |warning message        |
    ===============================


But the downsides to that usage are:

=over 4

=item * 

You'd better be darn sure there are not quotes in your log message, or your
insert could have unforseen consequences!  This is a very insecure way to
handle database inserts, using place holders and bind values is much better, 
keep reading. (Note that the log4j docs warn "Be careful of quotes in your 
messages!") B<*>.

=item *

It's not terribly high-performance, a statement is created and executed
for each log call.

=item *

The only run-time parameter you get is the %m message, in reality
you probably want to log specific data in specific table columns.

=back

So let's try using placeholders, and tell the logger to create a
prepared statement handle at the beginning and just reuse it 
(just like Log::Dispatch::DBI does)


    log4j.appender.DBAppndr.sql = \
       INSERT INTO logtbl \
          (custid, loglevel, message) \
          VALUES (?,?,?)

    #---------------------------------------------------
    #now the bind values:
                                  #1 is the custid
    log4j.appender.DBAppndr.params.2 = %p    
                                  #3 is the message
    #---------------------------------------------------

    log4j.appender.DBAppndr.layout    = Log::Log4perl::Layout::NoopLayout
    log4j.appender.DBAppndr.warp_message = 0
    
    log4j.appender.DBAppndr.usePreparedStmt = 1
    
    
    $logger->warn( 1234, 'warning message' ); 


Now see how we're using the '?' placeholders in our statement?  This
means we don't have to worry about messages that look like 

    invalid input: 1234';drop table custid;

fubaring our database!

Normally a list of things in the logging statement gets concatenated into 
a single string, but setting C<warp_message> to 0 and using the 
NoopLayout means that in

    $logger->warn( 1234, 'warning message', 'bgates' );

the individual list values will still be available for the DBI appender later 
on.  (If C<warp_message> is not set to 0, the default behavior is to
join the list elements into a single string.   If PatternLayout or SimpleLayout
are used, their attempt to C<render()> your layout will result in something 
like "ARRAY(0x841d8dc)" in your logs.  More information on C<warp_message>
is in Log::Log4perl::Appender.)

In your insert SQL you can mix up '?' placeholders with conversion specifiers 
(%c, %p, etc) as you see fit--the logger will match the question marks to 
params you've defined in the config file and populate the rest with values 
from your list.  If there are more '?' placeholders than there are values in 
your message, it will use undef for the rest.  For instance, 

	log4j.appender.DBAppndr.sql =                 \
	   insert into log4perltest                   \
	   (loglevel, message, datestr, subpoena_id)\
	   values (?,?,?,?)
	log4j.appender.DBAppndr.params.1 = %p
	log4j.appender.DBAppndr.params.3 = %d

	log4j.appender.DBAppndr.warp_message=0


	$logger->info('arrest him!', $subpoena_id);

results in the first '?' placholder being bound to %p, the second to
"arrest him!", the third to the date from "%d", and the fourth to your
$subpoenaid.  If you forget the $subpoena_id and just log

	$logger->info('arrest him!');

then you just get undef in the fourth column.


If the logger statement is also being handled by other non-DBI appenders,
they will just join the list into a string, joined with 
C<$Log::Log4perl::JOIN_MSG_ARRAY_CHAR> (default is an empty string).

And see the C<usePreparedStmt>?  That creates a statement handle when
the logger object is created and just reuses it.  That, however, may
be problematic for long-running processes like webservers, in which case
you can use this parameter instead

    log4j.appender.DBAppndr.bufferSize=2

This copies log4j's JDBCAppender's behavior, it saves up that many
log statements and writes them all out at once.  If your INSERT
statement uses only ? placeholders and no %x conversion specifiers
it should be quite efficient because the logger can re-use the
same statement handle for the inserts.

If the program ends while the buffer is only partly full, the DESTROY
block should flush the remaining statements, if the DESTROY block
runs of course.

* I<As I was writing this, Danko Mannhaupt was coming out with his
improved log4j JDBCAppender (http://www.mannhaupt.com/danko/projects/)
which overcomes many of the drawbacks of the original JDBCAppender.>

=head1 DESCRIPTION 2

Or another way to say the same thing:

The idea is that if you're logging to a database table, you probably
want specific parts of your log information in certain columns.  To this
end, you pass an list to the log statement, like 

    $logger->warn('big problem!!',$userid,$subpoena_nr,$ip_addr);

and the array members drop into the positions defined by the placeholders
in your SQL statement. You can also define information in the config
file like

    log4j.appender.DBAppndr.params.2 = %p    

in which case those numbered placeholders will be filled in with
the specified values, and the rest of the placeholders will be
filled in with the values from your log statement's array.

=head1 MISC PARAMETERS


=over 4

=item usePreparedStmt

See above.

=item warp_message

see Log::Log4perl::Appender

=item max_col_size

If you're used to just throwing debugging messages like huge stacktraces
into your logger, some databases (Sybase's DBD!!) may suprise you 
by choking on data size limitations.  Normally, the data would
just be truncated to fit in the column, but Sybases's DBD it turns out
maxes out at 255 characters.  Use this parameter in such a situation
to truncate long messages before they get to the INSERT statement.

=back

=head1 CHANGING DBH CONNECTIONS (POOLING)

If you want to get your dbh from some place in particular, like
maybe a pool, subclass and override _init() and/or create_statement(), 
for instance 

    sub _init {
        ; #no-op, no pooling at this level
    }
    sub create_statement {
        my ($self, $stmt) = @_;
    
        $stmt || croak "Log4perl: sql not set in ".__PACKAGE__;
    
        return My::Connections->getConnection->prepare($stmt) 
            || croak "Log4perl: DBI->prepare failed $DBI::errstr\n$stmt";
    }


=head1 LIFE OF CONNECTIONS

If you're using C<log4j.appender.DBAppndr.usePreparedStmt>
this module creates an sth when it starts and keeps it for the life
of the program.  For long-running processes (e.g. mod_perl), connections
might go stale, but if C<Log::Log4perl::Appender::DBI> tries to write
a message and figures out that the DB connection is no longer working
(using DBI's ping method), it will reconnect.

The reconnection process can be controlled by two parameters,
C<reconnect_attempts> and C<reconnect_sleep>. C<reconnect_attempts>
specifies the number of reconnections attempts the DBI appender 
performs until it gives up and dies. C<reconnect_sleep> is the
time between reconnection attempts, measured in seconds.
C<reconnect_attempts> defaults to 1,  C<reconnect_sleep> to 0.

Alternatively, use C<Apache::DBI> or C<Apache::DBI::Cache> and read
CHANGING DB CONNECTIONS above.

Note that C<Log::Log4perl::Appender::DBI> holds one connection open
for every appender, which might be too many.

=head1 SEE ALSO

L<Log::Dispatch::DBI>

L<Log::Log4perl::JavaMap::JDBCAppender>

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK       �&jZv9�I*  I*                  Limit.pmnu �[���        PK       �&jZ�I�                �*  ScreenColoredLevels.pmnu �[���        PK       �&jZ,
q7i  i  	            �A  Screen.pmnu �[���        PK       �&jZ�nN�(  �(              lN  Synchronized.pmnu �[���        PK       �&jZ%�XO	  O	              aw  TestFileCreeper.pmnu �[���        PK       �&jZ���W  W  	            �  Socket.pmnu �[���        PK       �&jZ_�8�   �   	            ��  Buffer.pmnu �[���        PK       �&jZ��so
  o
              ��  TestArrayBuffer.pmnu �[���        PK       �&jZ�!�y�  �              X�  RRDs.pmnu �[���        PK       �&jZ�s'�  �              ^�  TestBuffer.pmnu �[���        PK       �&jZ���
  �
  	            !�  String.pmnu �[���        PK       �&jZ!h�t|;  |;              �  File.pmnu �[���        PK       �&jZ���0JN  JN              �/ DBI.pmnu �[���        PK      �  ;~   