File Coverage

blib/lib/Log/Fine/Formatter/Template.pm
Criterion Covered Total %
statement 105 113 92.9
branch 39 60 65.0
condition 16 42 38.1
subroutine 25 25 100.0
pod 1 1 100.0
total 186 241 77.1


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