1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
# -*- perl -*-
#
# Net::Server::Log::Log::Log4perl - Net::Server Logging module
#
# $Id: Log4perl.pm,v 1.6 2012/06/06 03:54:26 rhandom Exp $
#
# Copyright (C) 2012
#
# Paul Seamons
# paul@seamons.com
#
# This package may be distributed under the terms of either the
# GNU General Public License
# or the
# Perl Artistic License
#
################################################################
package Net::Server::Log::Log::Log4perl;
use strict;
use warnings;
use Log::Log4perl;
our %log4perl_map = (1 => "error", 2 => "warn", 3 => "info", 4 => "debug");
sub initialize {
my ($class, $server) = @_;
my $prop = $server->{'server'};
$server->configure({
log4perl_conf => \$prop->{'log4perl_conf'},
log4perl_logger => \$prop->{'log4perl_logger'},
log4perl_poll => \$prop->{'log4perl_poll'},
});
die "Must specify a log4perl_conf file" if ! $prop->{'log4perl_conf'};
my $poll = defined($prop->{'log4perl_poll'}) ? $prop->{'log4perl_poll'} : "0";
my $logger = $prop->{'log4perl_logger'} || "Net::Server";
if ($poll eq "0") {
Log::Log4perl::init($prop->{'log4perl_conf'});
} else {
Log::Log4perl::init_and_watch($prop->{'log4perl_conf'}, $poll);
}
my $l4p = Log::Log4perl->get_logger($logger);
return sub {
my ($level, $msg) = @_;
$level = $log4perl_map{$level} || "error";
$l4p->$level($msg);
};
}
1;
__END__
=head1 NAME
Net::Server::Log::Log::Log4perl - log via Log4perl
=head1 SYNOPSIS
use base qw(Net::Server::PreFork);
__PACKAGE__->run(
log_file => 'Log::Log4perl',
log4perl_conf => '/path/to/my/log4perl.conf',
log4perl_logger => 'myapp',
);
=head1 DESCRIPTION
This module provides Log::Log4perl style logging to the Net::Server
system.
=head1 CONFIGURATION
=over 4
=item log_file
To begin using Log::Log4perl logging, simply set the Net::Server
log_file configuration parameter to "Log::Log4perl".
If the magic name "Log::Log4perl" is used, all logging will be
directed to the Log4perl system. If used, the C<log4perl_conf>,
C<log4perl_poll>, C<log4perl_logger> may also be defined.
=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".
=back
=head1 DEFAULT ARGUMENTS FOR Net::Server
The following arguments are available in the default C<Net::Server> or
C<Net::Server::Single> modules. (Other personalities may use
additional parameters and may optionally not use parameters from the
base class.)
Key Value Default
## log4perl parameters (if log_file eq Log::Log4perl)
log4perl_conf "filename" will die if not set
log4perl_poll number or HUP 0 (no polling)
log4perl_logger "name" "Net::Server"
=head1 METHODS
=over 4
=item C<initialize>
This method is called during the initilize_logging method of
Net::Server. It returns a single code ref that will be stored under
the log_function property of the Net::Server object. That code ref
takes log_level and message as arguments and calls the initialized
log4perl system.
=back
=head1 LICENCE
Distributed under the same terms as Net::Server
=cut
|
