Bug #64557 for Net-Server: Log4perl functionality

Hi! I like to use Log::Log4perl where possible. This patch adds Log::Log4perl functionality. The patch includes functionality, testing (including checking that a log is created) and documentation. Warning: On my debian system, using Log4perl increases the memory footprint from 9MB to 15MB, so there is a memory cost associated. If you incorporate this patch, please credit Ton Voon @ Opsera Limited. Ton

diff -uNr Net-Server-0.99.original/lib/Net/Server.pm Net-Server-0.99/lib/Net/Server.pm --- Net-Server-0.99.original/lib/Net/Server.pm 2010-07-09 14:55:31.000000000 +0000 +++ Net-Server-0.99/lib/Net/Server.pm 2011-01-06 23:07:24.000000000 +0000 @@ -255,6 +255,33 @@ $self->open_syslog; + ### create log4perl log_function + }elsif( $prop->{log_file} eq "Log::Log4perl" ){ + require Log::Log4perl; + + die "Must specify a log4perl_conf file" unless $prop->{log4perl_conf}; + + my $log4perl_poll = defined $prop->{log4perl_poll} ? $prop->{log4perl_poll} : 0; + my $log4perl_logger = $prop->{log4perl_logger} || "Net::Server"; + + if ($log4perl_poll eq "0") { + Log::Log4perl::init( $prop->{log4perl_conf} ); + }else{ + Log::Log4perl::init_and_watch( $prop->{log4perl_conf}, $log4perl_poll ); + } + my $logger = Log::Log4perl->get_logger( $log4perl_logger ); + $prop->{log_function} = sub { + my ($level, $msg) = @_; + my $level_lookup = { + 1 => "error", + 2 => "warn", + 3 => "info", + 4 => "debug", + }; + $level = $level_lookup->{$level} || "error"; + $logger->$level($msg); + }; + ### open a logging file }elsif( $prop->{log_file} && $prop->{log_file} ne 'Sys::Syslog' ){ @@ -1278,8 +1305,13 @@ # if multiple arguments are passed, assume that the first is a format string $msg = sprintf($msg, @therest) if @therest; + if ($prop->{log_function}) { + return if $level !~ /^\d+$/ || $level > $prop->{log_level}; + $prop->{log_function}->($level, $msg); + return; + } ### log only to syslog if setup to do syslog - if (defined($prop->{log_file}) && $prop->{log_file} eq 'Sys::Syslog') { + elsif (defined($prop->{log_file}) && $prop->{log_file} eq 'Sys::Syslog') { if ($level =~ /^\d+$/) { return if $level > $prop->{log_level}; $level = $Net::Server::syslog_map->{$level} || $level; @@ -1355,6 +1387,7 @@ listen reverse_lookups syslog_logsock syslog_ident syslog_logopt syslog_facility + log4perl_conf log4perl_logger log4perl_poll no_close_by_child no_client_stdout tie_client_stdout tied_stdout_callback tied_stdin_callback leave_children_open_on_hup diff -uNr Net-Server-0.99.original/lib/Net/Server.pod Net-Server-0.99/lib/Net/Server.pod --- Net-Server-0.99.original/lib/Net/Server.pod 2010-07-08 19:22:42.000000000 +0000 +++ Net-Server-0.99/lib/Net/Server.pod 2011-01-06 22:06:04.000000000 +0000 @@ -420,7 +420,8 @@ conf_file "filename" undef log_level 0-4 2 - log_file (filename|Sys::Syslog) undef + log_file (filename|Sys::Syslog + |Log::Log4perl) undef ## syslog parameters syslog_logsock (native|unix|inet|udp @@ -429,6 +430,11 @@ syslog_logopt (cons|ndelay|nowait|pid) pid syslog_facility \w+ daemon + ## log4perl parameters + log4perl_conf "filename" will die if not set + log4perl_poll number or HUP 0 (no polling) + log4perl_logger "name" "Net::Server" + port \d+ 20203 host "host" "*" proto (tcp|udp|unix) "tcp" @@ -548,6 +554,24 @@ Only available if C<log_file> is equal to "Sys::Syslog". See L<Sys::Syslog> and L<syslog>. Default is "daemon". +=item log4perl_conf + +Only available if C<log_file> is equal to "Log::Log4perl". +This is the filename of the log4perl configuration file - see +L<Log::Log4perl>. If this is not set, will die on startup. If the file +is not readable, will die. + +=item log4perl_poll + +If set to a value, will initialise with Log::Log4perl::init_and_watch +with this polling value. This can also be the string "HUP" to +re-read the log4perl_conf when a HUP signal is received. If set to +0, no polling is done. See L<Log::Log4perl> for more details. + +=item log4perl_logger + +This is the facility name. Defaults to "Net::Server". + =item port See L<Net::Server::Proto>. diff -uNr Net-Server-0.99.original/t/Options.t Net-Server-0.99/t/Options.t --- Net-Server-0.99.original/t/Options.t 2007-02-05 15:27:39.000000000 +0000 +++ Net-Server-0.99/t/Options.t 2011-01-06 22:58:08.000000000 +0000 @@ -10,7 +10,7 @@ use vars qw(@ISA); use strict; -use Test::More tests => 66; +use Test::More tests => 73; #use CGI::Ex::Dump qw(debug); use_ok('Net::Server'); @@ -240,3 +240,42 @@ })->{'server'} }; $prop ||= {}; ok($prop->{'group'} eq 'confgroup', "Right group \"$prop->{'group'}\""); + + +###----------------------------------------------------------------### + +SKIP: { + eval { require Log::Log4perl }; + + skip "Log::Log4perl not installed", 7 if $@; + + $prop = eval { FooServer->run( + log_file => "Log::Log4perl" + ) }; + like( $@, qr/Must specify a log4perl_conf file/, "Got error due to missing log4perl_conf" ); + + # This log file is same as specified in Options.t.log4perl + my $log4perl_file = "/tmp/net-server-test.log"; + unlink $log4perl_file; + $prop = eval { FooServer->run( + log_file => "Log::Log4perl", + log4perl_conf => __FILE__.".log4perl", + log4perl_logger => "tester", + )->{server} }; + # There was a test for a bad log4perl_conf file, but log4perl only allows you to initialise once + # so subsequent initialisations always had the bad filename + #like( $@, qr/Cannot open config file '.*?'/, "Got error due to missing log4perl_conf file" ); + is( $@, "", "No errors" ); + isa_ok( $prop->{log_function}, "CODE", "Log4perl initialised with function created" ); + ok( -e $log4perl_file, "Log file found" ); + is( -s $log4perl_file, 0, "With 0 bytes" ); + + $prop->{log_function}->( 1, "A test message" ); + isnt( -s $log4perl_file, 0, "Now has data" ); + + open F, $log4perl_file; + my $data = <F>; + close F; + is( $data, "ERROR - A test message\n", "Got expected log message" ); + +} diff -uNr Net-Server-0.99.original/t/Options.t.log4perl Net-Server-0.99/t/Options.t.log4perl --- Net-Server-0.99.original/t/Options.t.log4perl 1970-01-01 00:00:00.000000000 +0000 +++ Net-Server-0.99/t/Options.t.log4perl 2011-01-06 22:23:57.000000000 +0000 @@ -0,0 +1,5 @@ +log4perl.logger.tester = WARN, FileAppndr1 + +log4perl.appender.FileAppndr1 = Log::Log4perl::Appender::File +log4perl.appender.FileAppndr1.filename = /tmp/net-server-test.log +log4perl.appender.FileAppndr1.layout = Log::Log4perl::Layout::SimpleLayout