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   1989 use strict;
  4         5  
  4         93  
68 4     4   11 use warnings;
  4         3  
  4         124  
69              
70             package Log::Fine::Formatter::Template;
71              
72 4     4   33 use base qw( Log::Fine::Formatter );
  4         5  
  4         855  
73              
74 4     4   15 use Log::Fine;
  4         3  
  4         54  
75 4     4   11 use Log::Fine::Formatter;
  4         4  
  4         44  
76 4     4   14 use Log::Fine::Levels;
  4         4  
  4         105  
77              
78             our $VERSION = $Log::Fine::Formatter::VERSION;
79              
80 4     4   12 use File::Basename;
  4         3  
  4         202  
81 4     4   1190 use Sys::Hostname;
  4         2279  
  4         4512  
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 21 my $self = shift;
166 21         13 my $lvl = shift;
167 21         20 my $msg = shift;
168 21 50       34 my $skip = (defined $_[0]) ? shift : Log::Fine::Logger->LOG_SKIP_DEFAULT;
169              
170 21         28 my $tmpl = $self->{template};
171 21         58 my $v2l = $self->levelMap()->valueToLevel($lvl);
172 21   66     62 my $holders = $self->{_placeHolders} || $self->_placeHolders($tmpl);
173              
174             # Increment skip as calls to caller() are now encapsulated in
175             # anonymous functions
176 21         23 $skip++;
177              
178             # Level & message are variable values
179 21         50 $tmpl =~ s/%%LEVEL%%/$v2l/ig;
180 21         41 $tmpl =~ s/%%MSG%%/$msg/ig;
181              
182             # Fill in placeholders
183 21         51 foreach my $holder (keys %$holders) {
184 36         29 my $value = &{ $holders->{$holder} }($skip);
  36         58  
185 36         389 $tmpl =~ s/%%${holder}%%/$value/ig;
186             }
187              
188 21         317 return $tmpl;
189              
190             } # format()
191              
192             # --------------------------------------------------------------------
193              
194             ##
195             # Initializer for this object
196              
197             sub _init
198             {
199              
200 15     15   18 my $self = shift;
201              
202             # Perform any necessary upper class initializations
203 15         56 $self->SUPER::_init();
204              
205             # Make sure that template is defined
206             $self->_fatal("No template specified")
207             unless (defined $self->{template}
208 15 50 33     82 and $self->{template} =~ /\w/);
209              
210             # Set use_effective_id to default
211             $self->{use_effective_id} = 1
212             unless (defined $self->{use_effective_id}
213 15 50 33     50 and $self->{use_effective_id} =~ /\d/);
214              
215             # Do we have custom templates?
216             $self->_placeholderValidate()
217 15 100       34 if defined $self->{custom_placeholders};
218              
219             # Set up some defaults
220 14         38 $self->_fileName();
221 14         30 $self->_groupName();
222 14         38 $self->_hostName();
223 14         35 $self->_userName();
224              
225 14         40 return $self;
226              
227             } # _init()
228              
229             ##
230             # Getter/Setter for fileName
231              
232             sub _fileName
233             {
234              
235 14     14   13 my $self = shift;
236              
237             # Should {_fileName} be already cached, then return it, otherwise
238             # get the file name, cache it, and return
239             $self->{_fileName} = basename $0
240 14 50 33     660 unless (defined $self->{_fileName} and $self->{_fileName} =~ /\w/);
241              
242 14         36 return $self->{_fileName};
243              
244             } # _fileName()
245              
246             ##
247             # Getter/Setter for group
248              
249             sub _groupName
250             {
251              
252 14     14   19 my $self = shift;
253              
254             # Should {_groupName} be already cached, then return it,
255             # otherwise get the group name, cache it, and return
256 14 50 33     59 if (defined $self->{_groupName} and $self->{_groupName} =~ /\w/) {
    50          
257 0         0 return $self->{_groupName};
258             } elsif ($self->{use_effective_id}) {
259 14 50       37 if ($^O =~ /MSWin32/) {
260             $self->{_groupname} =
261             (defined $ENV{EGID})
262 0 0       0 ? (split(" ", $ENV{EGID}))[0]
263             : 0;
264             } else {
265 14   50     1409 $self->{_groupName} = getgrgid((split(" ", $)))[0])
266             || "nogroup";
267             }
268             } else {
269 0 0       0 if ($^O =~ /MSWin32/) {
270             $self->{_groupName} =
271             (defined $ENV{GID})
272 0 0       0 ? (split(" ", $ENV{GID}))[0]
273             : 0;
274             } else {
275 0   0     0 $self->{_groupname} = getgrgid((split(" ", $())[0])
276             || "nogroup";
277             }
278             }
279              
280 14         36 return $self->{_groupName};
281              
282             } # _groupName()
283              
284             ##
285             # Getter/Setter for hostname
286              
287             sub _hostName
288             {
289              
290 14     14   19 my $self = shift;
291              
292             # Should {_fullHost} be already cached, then return it,
293             # otherwise get hostname, cache it, and return
294             $self->{_fullHost} = hostname() || "{undef}"
295 14 50 50     72 unless (defined $self->{_fullHost} and $self->{_fullHost} =~ /\w/);
      33        
296              
297 14         94 return $self->{_fullHost};
298              
299             } # _hostName()
300              
301             ##
302             # Getter/Setter for placeholders
303              
304             sub _placeHolders
305             {
306              
307 14     14   13 my $self = shift;
308 14         13 my $tmpl = shift;
309              
310             # Should {_placeHolders} be already cached, then return it,
311             # otherwise generate placeholders and return
312 14 50 33     36 if (defined $self->{_placeHolders}
313             and ref $self->{_placeHolders} eq "HASH") {
314 0         0 return $self->{_placeHolders};
315             } else {
316              
317 14         19 my $placeholders = {};
318              
319 12     12   36 $placeholders->{time} = sub { return $self->_formatTime() }
320 14 100       54 if ($tmpl =~ /%%TIME%%/i);
321              
322             $placeholders->{package} = sub {
323 3     3   4 my $skip = shift;
324 3   50     14 return (caller($skip))[0] || "{undef}";
325             }
326 14 100       33 if ($tmpl =~ /%%PACKAGE%%/i);
327              
328 3     3   9 $placeholders->{filename} = sub { return $self->{_fileName} }
329 14 100       32 if ($tmpl =~ /%%FILENAME%%/i);
330              
331 6   50 6   8 $placeholders->{lineno} = sub { my $skip = shift; return (caller($skip))[2] || 0 }
  6         27  
332 14 100       31 if ($tmpl =~ /%%LINENO%%/i);
333              
334             $placeholders->{subrout} = sub {
335 6     6   6 my $skip = shift;
336 6   100     30 return (caller(++$skip))[3] || "main";
337             }
338 14 100       30 if ($tmpl =~ /%%SUBROUT%%/i);
339              
340 1     1   5 $placeholders->{hostshort} = sub { return (split /\./, $self->{_fullHost})[0] }
341 14 100       27 if ($tmpl =~ /%%HOSTSHORT%%/i);
342              
343 1     1   2 $placeholders->{hostlong} = sub { return $self->{_fullHost} }
344 14 100       28 if ($tmpl =~ /%%HOSTLONG%%/i);
345              
346 1     1   3 $placeholders->{user} = sub { return $self->{_userName} }
347 14 100       30 if ($tmpl =~ /%%USER%%/i);
348              
349 1     1   3 $placeholders->{group} = sub { return $self->{_groupName} }
350 14 100       28 if ($tmpl =~ /%%GROUP%%/i);
351              
352             # Check for custom templates
353 14 100       21 if (defined $self->{custom_placeholders}) {
354              
355 1         2 foreach my $placeholder (keys %{ $self->{custom_placeholders} }) {
  1         4  
356 1 50       12 $placeholders->{$placeholder} = $self->{custom_placeholders}->{$placeholder}
357             if ($tmpl =~ /%%${placeholder}%%/i);
358             }
359              
360             }
361              
362 14         19 $self->{_placeHolders} = $placeholders;
363              
364 14         43 return $placeholders;
365              
366             }
367              
368             } # _placeHolder()
369              
370             ##
371             # Validator for custom placeholders
372              
373             sub _placeholderValidate
374             {
375              
376 2     2   3 my $self = shift;
377 2         3 my $holders = {};
378              
379             $self->_fatal("{custom_placeholders} must be a valid hash ref")
380 2 50       7 unless ref $self->{custom_placeholders} eq "HASH";
381              
382 2         3 foreach my $placeholder (keys %{ $self->{custom_placeholders} }) {
  2         9  
383              
384             $self->_fatal(
385             sprintf("custom template '%s' must point to " . "a valid function ref : %s",
386             $placeholder, ref $self->{custom_placeholders}->{$placeholder})
387 3 50       8 ) unless ref $self->{custom_placeholders}->{$placeholder} eq "CODE";
388              
389             # Check for duplicate placeholders
390 3 100       7 if (defined $holders->{ lc($placeholder) }) {
391 1         15 $self->_fatal(
392             sprintf("Duplicate placeholder '%s' found. " . "Remember, placeholders are case-INsensitive",
393             $placeholder
394             ));
395             } else {
396 2         4 $holders->{ lc($placeholder) } = 1;
397             }
398              
399             }
400              
401 1         2 return 1;
402              
403             } # _placeholderValidate()
404              
405             ##
406             # Getter/Setter for user name
407              
408             sub _userName
409             {
410              
411 14     14   16 my $self = shift;
412              
413             # Should {_userName} be already cached, then return it,
414             # otherwise get the user name, cache it, and return
415 14 50 33     59 if (defined $self->{_userName} and $self->{_userName} =~ /\w/) {
    50          
416 0         0 return $self->{_userName};
417             } elsif ($self->{use_effective_id}) {
418             $self->{_userName} =
419             ($^O eq "MSWin32")
420 14 50 0     665 ? $ENV{EUID} || 0
      50        
421             : getpwuid($>) || "nobody";
422             } else {
423 0   0     0 $self->{_userName} = getlogin() || getpwuid($<) || "nobody";
424             }
425              
426 14         72 return $self->{_userName};
427              
428             } # _userName()
429              
430             =head1 MICROSOFT WINDOWS CAVEATS
431              
432             Under Microsoft Windows operating systems (WinXP, Win2003, Vista,
433             Win7, etc.), Log::Fine::Formatters::Template will use the following
434             environment variables for determining user and group information:
435              
436             =over
437              
438             =item * C<$UID>
439              
440             =item * C<$EUID>
441              
442             =item * C<$GID>
443              
444             =item * C<$EGID>
445              
446             =back
447              
448             Under MS Windows, these values will invariably be set to 0.
449              
450             =head1 BUGS
451              
452             Please report any bugs or feature requests to
453             C, or through the web interface at
454             L.
455             I will be notified, and then you'll automatically be notified of progress on
456             your bug as I make changes.
457              
458             =head1 SUPPORT
459              
460             You can find documentation for this module with the perldoc command.
461              
462             perldoc Log::Fine
463              
464             You can also look for information at:
465              
466             =over 4
467              
468             =item * AnnoCPAN: Annotated CPAN documentation
469              
470             L
471              
472             =item * CPAN Ratings
473              
474             L
475              
476             =item * RT: CPAN's request tracker
477              
478             L
479              
480             =item * Search CPAN
481              
482             L
483              
484             =back
485              
486             =head1 AUTHOR
487              
488             Christopher M. Fuhrman, C<< >>
489              
490             =head1 SEE ALSO
491              
492             L, L
493              
494             =head1 COPYRIGHT & LICENSE
495              
496             Copyright (c) 2010-2011, 2013 Christopher M. Fuhrman,
497             All rights reserved.
498              
499             This program is free software licensed under the...
500              
501             The BSD License
502              
503             The full text of the license can be found in the
504             LICENSE file included with this module.
505              
506             =cut
507              
508             1; # End of Log::Fine::Formatter::Template