| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
=head1 NAME |
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
Log::Fine::Formatter::Template - Format log messages using template |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Formats log messages for output using a user-defined template spec. |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use Log::Fine::Formatter::Template; |
|
11
|
|
|
|
|
|
|
use Log::Fine::Handle::Console; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Instantiate a handle |
|
14
|
|
|
|
|
|
|
my $handle = Log::Fine::Handle::Console->new(); |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Instantiate a formatter |
|
17
|
|
|
|
|
|
|
my $formatter = Log::Fine::Formatter::Template |
|
18
|
|
|
|
|
|
|
->new( |
|
19
|
|
|
|
|
|
|
name => 'template0', |
|
20
|
|
|
|
|
|
|
template => "[%%TIME%%] %%LEVEL%% (%%FILENAME%%:%%LINENO%%) %%MSG%%\n", |
|
21
|
|
|
|
|
|
|
timestamp_format => "%y-%m-%d %h:%m:%s" |
|
22
|
|
|
|
|
|
|
); |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Set the formatter |
|
25
|
|
|
|
|
|
|
$handle->formatter( formatter => $formatter ); |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# When displaying user or group information, use the effective |
|
28
|
|
|
|
|
|
|
# user ID |
|
29
|
|
|
|
|
|
|
my $formatter = Log::Fine::Formatter::Template |
|
30
|
|
|
|
|
|
|
->new( |
|
31
|
|
|
|
|
|
|
name => 'template0', |
|
32
|
|
|
|
|
|
|
template => "[%%TIME%%] %%USER%%@%%HOSTNAME%% %%%LEVEL%% %%MSG%%\n", |
|
33
|
|
|
|
|
|
|
timestamp_format => "%y-%m-%d %h:%m:%s", |
|
34
|
|
|
|
|
|
|
use_effective_id => 1, |
|
35
|
|
|
|
|
|
|
); |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Format a msg |
|
38
|
|
|
|
|
|
|
my $str = $formatter->format(INFO, "Resistence is futile", 1); |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Create a template with a custom placeholder |
|
41
|
|
|
|
|
|
|
my $counter = 0; |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Function that's invoked by the template engine |
|
44
|
|
|
|
|
|
|
sub foobar { ++$counter; } |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $formatter = Log::Fine::Formatter::Template |
|
47
|
|
|
|
|
|
|
->new( |
|
48
|
|
|
|
|
|
|
name => 'template0', |
|
49
|
|
|
|
|
|
|
template => "[%%TIME%%] %%LEVEL%% (%%FILENAME%%:%%LINENO%%) (COUNT:%%FOOBAR%%) %%MSG%%\n", |
|
50
|
|
|
|
|
|
|
timestamp_format => "%y-%m-%d %h:%m:%s", |
|
51
|
|
|
|
|
|
|
custom_placeholders => { |
|
52
|
|
|
|
|
|
|
FOOBAR => \&foobar, |
|
53
|
|
|
|
|
|
|
}); |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
The template formatter allows the user to specify the log format via a |
|
58
|
|
|
|
|
|
|
template, using placeholders as substitutions. This provides the user |
|
59
|
|
|
|
|
|
|
an alternative way of formatting their log messages without the |
|
60
|
|
|
|
|
|
|
necessity of having to write their own formatter object. |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Note that if you desire speed, consider rolling your own |
|
63
|
|
|
|
|
|
|
Log::Fine::Formatter module. |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
|
66
|
|
|
|
|
|
|
|
|
67
|
4
|
|
|
4
|
|
3732
|
use strict; |
|
|
4
|
|
|
|
|
9
|
|
|
|
4
|
|
|
|
|
157
|
|
|
68
|
4
|
|
|
4
|
|
23
|
use warnings; |
|
|
4
|
|
|
|
|
9
|
|
|
|
4
|
|
|
|
|
187
|
|
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
package Log::Fine::Formatter::Template; |
|
71
|
|
|
|
|
|
|
|
|
72
|
4
|
|
|
4
|
|
23
|
use base qw( Log::Fine::Formatter ); |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
1365
|
|
|
73
|
|
|
|
|
|
|
|
|
74
|
4
|
|
|
4
|
|
24
|
use Log::Fine; |
|
|
4
|
|
|
|
|
8
|
|
|
|
4
|
|
|
|
|
92
|
|
|
75
|
4
|
|
|
4
|
|
27
|
use Log::Fine::Formatter; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
83
|
|
|
76
|
4
|
|
|
4
|
|
21
|
use Log::Fine::Levels; |
|
|
4
|
|
|
|
|
8
|
|
|
|
4
|
|
|
|
|
152
|
|
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
our $VERSION = $Log::Fine::Formatter::VERSION; |
|
79
|
|
|
|
|
|
|
|
|
80
|
4
|
|
|
4
|
|
23
|
use File::Basename; |
|
|
4
|
|
|
|
|
10
|
|
|
|
4
|
|
|
|
|
333
|
|
|
81
|
4
|
|
|
4
|
|
3016
|
use Sys::Hostname; |
|
|
4
|
|
|
|
|
4268
|
|
|
|
4
|
|
|
|
|
9136
|
|
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 SUPPORTED PLACEHOLDERS |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Placeholders are case-insensitive. C<%%msg%%> will work just as well |
|
86
|
|
|
|
|
|
|
as C<%%MSG%%> |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
89
|
|
|
|
|
|
|
| %%TIME%% | Timestamp | |
|
90
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
91
|
|
|
|
|
|
|
| %%LEVEL%% | Log Level | |
|
92
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
93
|
|
|
|
|
|
|
| %%MSG%% | Log Message | |
|
94
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
95
|
|
|
|
|
|
|
| %%PACKAGE%% | Caller package | |
|
96
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
97
|
|
|
|
|
|
|
| %%FILENAME%% | Caller filename | |
|
98
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
99
|
|
|
|
|
|
|
| %%LINENO%% | Caller line number | |
|
100
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
101
|
|
|
|
|
|
|
| %%SUBROUT%% | Caller Subroutine | |
|
102
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
103
|
|
|
|
|
|
|
| %%HOSTLONG%% | Long Hostname including domain | |
|
104
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
105
|
|
|
|
|
|
|
| %%HOSTSHORT%% | Short Hostname | |
|
106
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
107
|
|
|
|
|
|
|
| %%LOGIN%% | User Login | |
|
108
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
109
|
|
|
|
|
|
|
| %%GROUP%% | User Group | |
|
110
|
|
|
|
|
|
|
+---------------+-----------------------------------+ |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 CUSTOM PLACEHOLDERS |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Custom placeholders may be defined as follows: |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $counter = 0; |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub foobar { return ++$counter; } # foobar() |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# Define a template formatter with a custom keyword, FOOBAR |
|
121
|
|
|
|
|
|
|
my $template = Log::Fine::Formatter::Template |
|
122
|
|
|
|
|
|
|
->new(name => 'template2', |
|
123
|
|
|
|
|
|
|
template => "[%%TIME%%] %%LEVEL%% (count:%%FOOBAR%%) %%MSG%%\n", |
|
124
|
|
|
|
|
|
|
custom_placeholders => { |
|
125
|
|
|
|
|
|
|
FOOBAR => \&foobar, |
|
126
|
|
|
|
|
|
|
}); |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Note that C<< $template->{custom_placeholders} >> is a hash ref with each |
|
129
|
|
|
|
|
|
|
key representing a new placeholder that points to a function ref. |
|
130
|
|
|
|
|
|
|
Like regular placeholders, custom placeholders are case-insensitive. |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 METHODS |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 format |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Formats the given message for the given level |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head3 Parameters |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=over |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item * level |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Level at which to log (see L) |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item * message |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Message to log |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item * skip |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Controls caller skip level |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=back |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head3 Returns |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
The formatted log message as specified by {template} |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=cut |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub format |
|
163
|
|
|
|
|
|
|
{ |
|
164
|
|
|
|
|
|
|
|
|
165
|
21
|
|
|
21
|
1
|
37
|
my $self = shift; |
|
166
|
21
|
|
|
|
|
33
|
my $lvl = shift; |
|
167
|
21
|
|
|
|
|
37
|
my $msg = shift; |
|
168
|
21
|
50
|
|
|
|
63
|
my $skip = |
|
169
|
|
|
|
|
|
|
(defined $_[0]) ? shift : Log::Fine::Logger->LOG_SKIP_DEFAULT; |
|
170
|
|
|
|
|
|
|
|
|
171
|
21
|
|
|
|
|
90
|
my $tmpl = $self->{template}; |
|
172
|
21
|
|
|
|
|
95
|
my $v2l = $self->levelMap()->valueToLevel($lvl); |
|
173
|
21
|
|
66
|
|
|
115
|
my $holders = $self->{_placeHolders} || $self->_placeHolders($tmpl); |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Increment skip as calls to caller() are now encapsulated in |
|
176
|
|
|
|
|
|
|
# anonymous functions |
|
177
|
21
|
|
|
|
|
32
|
$skip++; |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Level & message are variable values |
|
180
|
21
|
|
|
|
|
90
|
$tmpl =~ s/%%LEVEL%%/$v2l/ig; |
|
181
|
21
|
|
|
|
|
81
|
$tmpl =~ s/%%MSG%%/$msg/ig; |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Fill in placeholders |
|
184
|
21
|
|
|
|
|
77
|
foreach my $holder (keys %$holders) { |
|
185
|
36
|
|
|
|
|
59
|
my $value = &{ $holders->{$holder} }($skip); |
|
|
36
|
|
|
|
|
124
|
|
|
186
|
36
|
|
|
|
|
594
|
$tmpl =~ s/%%${holder}%%/$value/ig; |
|
187
|
|
|
|
|
|
|
} |
|
188
|
|
|
|
|
|
|
|
|
189
|
21
|
|
|
|
|
538
|
return $tmpl; |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
} # format() |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# -------------------------------------------------------------------- |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
## |
|
196
|
|
|
|
|
|
|
# Initializer for this object |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub _init |
|
199
|
|
|
|
|
|
|
{ |
|
200
|
|
|
|
|
|
|
|
|
201
|
15
|
|
|
15
|
|
26
|
my $self = shift; |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Perform any necessary upper class initializations |
|
204
|
15
|
|
|
|
|
75
|
$self->SUPER::_init(); |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Make sure that template is defined |
|
207
|
15
|
50
|
33
|
|
|
118
|
$self->_fatal("No template specified") |
|
208
|
|
|
|
|
|
|
unless (defined $self->{template} |
|
209
|
|
|
|
|
|
|
and $self->{template} =~ /\w/); |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Set use_effective_id to default |
|
212
|
15
|
50
|
33
|
|
|
70
|
$self->{use_effective_id} = 1 |
|
213
|
|
|
|
|
|
|
unless (defined $self->{use_effective_id} |
|
214
|
|
|
|
|
|
|
and $self->{use_effective_id} =~ /\d/); |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Do we have custom templates? |
|
217
|
15
|
100
|
|
|
|
47
|
$self->_placeholderValidate() |
|
218
|
|
|
|
|
|
|
if defined $self->{custom_placeholders}; |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Set up some defaults |
|
221
|
14
|
|
|
|
|
48
|
$self->_fileName(); |
|
222
|
14
|
|
|
|
|
42
|
$self->_groupName(); |
|
223
|
14
|
|
|
|
|
44
|
$self->_hostName(); |
|
224
|
14
|
|
|
|
|
38
|
$self->_userName(); |
|
225
|
|
|
|
|
|
|
|
|
226
|
14
|
|
|
|
|
39
|
return $self; |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
} # _init() |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
## |
|
231
|
|
|
|
|
|
|
# Getter/Setter for fileName |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub _fileName |
|
234
|
|
|
|
|
|
|
{ |
|
235
|
|
|
|
|
|
|
|
|
236
|
14
|
|
|
14
|
|
21
|
my $self = shift; |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Should {_fileName} be already cached, then return it, otherwise |
|
239
|
|
|
|
|
|
|
# get the file name, cache it, and return |
|
240
|
14
|
50
|
33
|
|
|
806
|
$self->{_fileName} = basename $0 |
|
241
|
|
|
|
|
|
|
unless (defined $self->{_fileName} and $self->{_fileName} =~ /\w/); |
|
242
|
|
|
|
|
|
|
|
|
243
|
14
|
|
|
|
|
43
|
return $self->{_fileName}; |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
} # _fileName() |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
## |
|
248
|
|
|
|
|
|
|
# Getter/Setter for group |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub _groupName |
|
251
|
|
|
|
|
|
|
{ |
|
252
|
|
|
|
|
|
|
|
|
253
|
14
|
|
|
14
|
|
23
|
my $self = shift; |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Should {_groupName} be already cached, then return it, |
|
256
|
|
|
|
|
|
|
# otherwise get the group name, cache it, and return |
|
257
|
14
|
50
|
33
|
|
|
76
|
if (defined $self->{_groupName} and $self->{_groupName} =~ /\w/) { |
|
|
|
50
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
0
|
return $self->{_groupName}; |
|
259
|
|
|
|
|
|
|
} elsif ($self->{use_effective_id}) { |
|
260
|
14
|
50
|
|
|
|
57
|
if ($^O =~ /MSWin32/) { |
|
261
|
0
|
0
|
|
|
|
0
|
$self->{_groupname} = |
|
262
|
|
|
|
|
|
|
(defined $ENV{EGID}) |
|
263
|
|
|
|
|
|
|
? (split(" ", $ENV{EGID}))[0] |
|
264
|
|
|
|
|
|
|
: 0; |
|
265
|
|
|
|
|
|
|
} else { |
|
266
|
14
|
|
50
|
|
|
2280
|
$self->{_groupName} = getgrgid((split(" ", $)))[0]) |
|
267
|
|
|
|
|
|
|
|| "nogroup"; |
|
268
|
|
|
|
|
|
|
} |
|
269
|
|
|
|
|
|
|
} else { |
|
270
|
0
|
0
|
|
|
|
0
|
if ($^O =~ /MSWin32/) { |
|
271
|
0
|
0
|
|
|
|
0
|
$self->{_groupName} = |
|
272
|
|
|
|
|
|
|
(defined $ENV{GID}) |
|
273
|
|
|
|
|
|
|
? (split(" ", $ENV{GID}))[0] |
|
274
|
|
|
|
|
|
|
: 0; |
|
275
|
|
|
|
|
|
|
} else { |
|
276
|
0
|
|
0
|
|
|
0
|
$self->{_groupname} = getgrgid((split(" ", $())[0]) |
|
277
|
|
|
|
|
|
|
|| "nogroup"; |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
14
|
|
|
|
|
45
|
return $self->{_groupName}; |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
} # _groupName() |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
## |
|
286
|
|
|
|
|
|
|
# Getter/Setter for hostname |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub _hostName |
|
289
|
|
|
|
|
|
|
{ |
|
290
|
|
|
|
|
|
|
|
|
291
|
14
|
|
|
14
|
|
24
|
my $self = shift; |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Should {_fullHost} be already cached, then return it, |
|
294
|
|
|
|
|
|
|
# otherwise get hostname, cache it, and return |
|
295
|
14
|
50
|
50
|
|
|
100
|
$self->{_fullHost} = hostname() || "{undef}" |
|
|
|
|
33
|
|
|
|
|
|
296
|
|
|
|
|
|
|
unless (defined $self->{_fullHost} and $self->{_fullHost} =~ /\w/); |
|
297
|
|
|
|
|
|
|
|
|
298
|
14
|
|
|
|
|
122
|
return $self->{_fullHost}; |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
} # _hostName() |
|
301
|
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
## |
|
303
|
|
|
|
|
|
|
# Getter/Setter for placeholders |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub _placeHolders |
|
306
|
|
|
|
|
|
|
{ |
|
307
|
|
|
|
|
|
|
|
|
308
|
14
|
|
|
14
|
|
24
|
my $self = shift; |
|
309
|
14
|
|
|
|
|
30
|
my $tmpl = shift; |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# Should {_placeHolders} be already cached, then return it, |
|
312
|
|
|
|
|
|
|
# otherwise generate placeholders and return |
|
313
|
14
|
50
|
33
|
|
|
58
|
if (defined $self->{_placeHolders} |
|
314
|
|
|
|
|
|
|
and ref $self->{_placeHolders} eq "HASH") { |
|
315
|
0
|
|
|
|
|
0
|
return $self->{_placeHolders}; |
|
316
|
|
|
|
|
|
|
} else { |
|
317
|
|
|
|
|
|
|
|
|
318
|
14
|
|
|
|
|
31
|
my $placeholders = {}; |
|
319
|
|
|
|
|
|
|
|
|
320
|
12
|
|
|
12
|
|
63
|
$placeholders->{time} = sub { return $self->_formatTime() } |
|
321
|
14
|
100
|
|
|
|
97
|
if ($tmpl =~ /%%TIME%%/i); |
|
322
|
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
$placeholders->{package} = sub { |
|
324
|
3
|
|
|
3
|
|
6
|
my $skip = shift; |
|
325
|
3
|
|
50
|
|
|
29
|
return (caller($skip))[0] || "{undef}"; |
|
326
|
|
|
|
|
|
|
} |
|
327
|
14
|
100
|
|
|
|
235
|
if ($tmpl =~ /%%PACKAGE%%/i); |
|
328
|
|
|
|
|
|
|
|
|
329
|
3
|
|
|
3
|
|
15
|
$placeholders->{filename} = sub { return $self->{_fileName} } |
|
330
|
14
|
100
|
|
|
|
56
|
if ($tmpl =~ /%%FILENAME%%/i); |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
$placeholders->{lineno} = |
|
333
|
6
|
|
50
|
6
|
|
13
|
sub { my $skip = shift; return (caller($skip))[2] || 0 } |
|
|
6
|
|
|
|
|
46
|
|
|
334
|
14
|
100
|
|
|
|
62
|
if ($tmpl =~ /%%LINENO%%/i); |
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
$placeholders->{subrout} = sub { |
|
337
|
6
|
|
|
6
|
|
12
|
my $skip = shift; |
|
338
|
6
|
|
100
|
|
|
47
|
return (caller(++$skip))[3] || "main"; |
|
339
|
|
|
|
|
|
|
} |
|
340
|
14
|
100
|
|
|
|
73
|
if ($tmpl =~ /%%SUBROUT%%/i); |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
$placeholders->{hostshort} = |
|
343
|
1
|
|
|
1
|
|
7
|
sub { return (split /\./, $self->{_fullHost})[0] } |
|
344
|
14
|
100
|
|
|
|
54
|
if ($tmpl =~ /%%HOSTSHORT%%/i); |
|
345
|
|
|
|
|
|
|
|
|
346
|
1
|
|
|
1
|
|
5
|
$placeholders->{hostlong} = sub { return $self->{_fullHost} } |
|
347
|
14
|
100
|
|
|
|
183
|
if ($tmpl =~ /%%HOSTLONG%%/i); |
|
348
|
|
|
|
|
|
|
|
|
349
|
1
|
|
|
1
|
|
5
|
$placeholders->{user} = sub { return $self->{_userName} } |
|
350
|
14
|
100
|
|
|
|
54
|
if ($tmpl =~ /%%USER%%/i); |
|
351
|
|
|
|
|
|
|
|
|
352
|
1
|
|
|
1
|
|
4
|
$placeholders->{group} = sub { return $self->{_groupName} } |
|
353
|
14
|
100
|
|
|
|
46
|
if ($tmpl =~ /%%GROUP%%/i); |
|
354
|
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Check for custom templates |
|
356
|
14
|
100
|
|
|
|
47
|
if (defined $self->{custom_placeholders}) { |
|
357
|
|
|
|
|
|
|
|
|
358
|
1
|
|
|
|
|
2
|
foreach my $placeholder ( |
|
|
1
|
|
|
|
|
4
|
|
|
359
|
|
|
|
|
|
|
keys %{ $self->{custom_placeholders} }) { |
|
360
|
1
|
50
|
|
|
|
18
|
$placeholders->{$placeholder} = |
|
361
|
|
|
|
|
|
|
$self->{custom_placeholders}->{$placeholder} |
|
362
|
|
|
|
|
|
|
if ($tmpl =~ /%%${placeholder}%%/i); |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
} |
|
366
|
|
|
|
|
|
|
|
|
367
|
14
|
|
|
|
|
29
|
$self->{_placeHolders} = $placeholders; |
|
368
|
|
|
|
|
|
|
|
|
369
|
14
|
|
|
|
|
78
|
return $placeholders; |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
} |
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# |
|
374
|
|
|
|
|
|
|
# NOT REACHED |
|
375
|
|
|
|
|
|
|
# |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
} # _placeHolder() |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
## |
|
380
|
|
|
|
|
|
|
# Validator for custom placeholders |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub _placeholderValidate |
|
383
|
|
|
|
|
|
|
{ |
|
384
|
|
|
|
|
|
|
|
|
385
|
2
|
|
|
2
|
|
6
|
my $self = shift; |
|
386
|
2
|
|
|
|
|
4
|
my $holders = {}; |
|
387
|
|
|
|
|
|
|
|
|
388
|
2
|
50
|
|
|
|
9
|
$self->_fatal("{custom_placeholders} must be a valid hash ref") |
|
389
|
|
|
|
|
|
|
unless ref $self->{custom_placeholders} eq "HASH"; |
|
390
|
|
|
|
|
|
|
|
|
391
|
2
|
|
|
|
|
3
|
foreach my $placeholder (keys %{ $self->{custom_placeholders} }) { |
|
|
2
|
|
|
|
|
9
|
|
|
392
|
|
|
|
|
|
|
|
|
393
|
3
|
50
|
|
|
|
11
|
$self->_fatal( |
|
394
|
|
|
|
|
|
|
sprintf("custom template '%s' must point to " |
|
395
|
|
|
|
|
|
|
. "a valid function ref : %s", |
|
396
|
|
|
|
|
|
|
$placeholder, |
|
397
|
|
|
|
|
|
|
ref $self->{custom_placeholders}->{$placeholder} |
|
398
|
|
|
|
|
|
|
)) |
|
399
|
|
|
|
|
|
|
unless ref $self->{custom_placeholders}->{$placeholder} eq |
|
400
|
|
|
|
|
|
|
"CODE"; |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Check for duplicate placeholders |
|
403
|
3
|
100
|
|
|
|
10
|
if (defined $holders->{ lc($placeholder) }) { |
|
404
|
1
|
|
|
|
|
22
|
$self->_fatal( |
|
405
|
|
|
|
|
|
|
sprintf("Duplicate placeholder '%s' found. " |
|
406
|
|
|
|
|
|
|
. "Remember, placeholders are case-INsensitive", |
|
407
|
|
|
|
|
|
|
$placeholder |
|
408
|
|
|
|
|
|
|
)); |
|
409
|
|
|
|
|
|
|
} else { |
|
410
|
2
|
|
|
|
|
8
|
$holders->{ lc($placeholder) } = 1; |
|
411
|
|
|
|
|
|
|
} |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
} |
|
414
|
|
|
|
|
|
|
|
|
415
|
1
|
|
|
|
|
4
|
return 1; |
|
416
|
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
} # _placeholderValidate() |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
## |
|
420
|
|
|
|
|
|
|
# Getter/Setter for user name |
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub _userName |
|
423
|
|
|
|
|
|
|
{ |
|
424
|
|
|
|
|
|
|
|
|
425
|
14
|
|
|
14
|
|
25
|
my $self = shift; |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# Should {_userName} be already cached, then return it, |
|
428
|
|
|
|
|
|
|
# otherwise get the user name, cache it, and return |
|
429
|
14
|
50
|
33
|
|
|
77
|
if (defined $self->{_userName} and $self->{_userName} =~ /\w/) { |
|
|
|
50
|
|
|
|
|
|
|
430
|
0
|
|
|
|
|
0
|
return $self->{_userName}; |
|
431
|
|
|
|
|
|
|
} elsif ($self->{use_effective_id}) { |
|
432
|
14
|
50
|
0
|
|
|
1011
|
$self->{_userName} = |
|
|
|
|
50
|
|
|
|
|
|
433
|
|
|
|
|
|
|
($^O eq "MSWin32") |
|
434
|
|
|
|
|
|
|
? $ENV{EUID} || 0 |
|
435
|
|
|
|
|
|
|
: getpwuid($>) || "nobody"; |
|
436
|
|
|
|
|
|
|
} else { |
|
437
|
0
|
|
0
|
|
|
0
|
$self->{_userName} = getlogin() || getpwuid($<) || "nobody"; |
|
438
|
|
|
|
|
|
|
} |
|
439
|
|
|
|
|
|
|
|
|
440
|
14
|
|
|
|
|
41
|
return $self->{_userName}; |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
} # _userName() |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head1 MICROSOFT WINDOWS CAVEATS |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Under Microsoft Windows operating systems (WinXP, Win2003, Vista, |
|
447
|
|
|
|
|
|
|
Win7, etc), Log::Fine::Formatters::Template will use the following |
|
448
|
|
|
|
|
|
|
environment variables for determining user and group information: |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=over |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=item * C<$UID> |
|
453
|
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=item * C<$EUID> |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=item * C<$GID> |
|
457
|
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=item * C<$EGID> |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=back |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Under MS Windows, these values will invariably be set to 0. |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head1 BUGS |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
|
467
|
|
|
|
|
|
|
C, or through the web interface at |
|
468
|
|
|
|
|
|
|
L. |
|
469
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
|
470
|
|
|
|
|
|
|
your bug as I make changes. |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=head1 SUPPORT |
|
473
|
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
perldoc Log::Fine |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
You can also look for information at: |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=over 4 |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
L |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=item * CPAN Ratings |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
L |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
L |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item * Search CPAN |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
L |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=back |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=head1 AUTHOR |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Christopher M. Fuhrman, C<< >> |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
L, L |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Copyright (c) 2010-2011, 2013 Christopher M. Fuhrman, |
|
511
|
|
|
|
|
|
|
All rights reserved. |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
This program is free software licensed under the... |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
The BSD License |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
The full text of the license can be found in the |
|
518
|
|
|
|
|
|
|
LICENSE file included with this module. |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=cut |
|
521
|
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
1; # End of Log::Fine::Formatter::Template |