File Coverage

blib/lib/Log/Fine.pm
Criterion Covered Total %
statement 62 69 89.8
branch 16 26 61.5
condition 25 55 45.4
subroutine 18 18 100.0
pod 5 5 100.0
total 126 173 72.8


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Log::Fine - Yet another logging framework
5              
6             =head1 SYNOPSIS
7              
8             Provides fine-grained logging and tracing.
9              
10             use Log::Fine;
11             use Log::Fine::Levels::Syslog; # exports log levels
12             use Log::Fine::Levels::Syslog qw( :masks ); # exports masks and levels
13              
14             # Build a Log::Fine object
15             my $fine = Log::Fine->new();
16              
17             # Specify a custom map
18             my $fine = Log::Fine->new(levelmap => "Syslog");
19              
20             # Get the name of the log object
21             my $name = $fine->name();
22              
23             # Use logger() to get a new logger object. If "foo" is not
24             # defined then a new logger with the name "foo" will be created.
25             my $log = Log::Fine->logger("foo");
26              
27             # Get list of names of defined logger objects
28             my @loggers = $log->listLoggers();
29              
30             # Register a handle, in this case a handle that logs to console.
31             my $handle = Log::Fine::Handle::Console->new();
32             $log->registerHandle( $handle );
33              
34             # Log a message
35             $log->log(INFO, "Log object successfully initialized");
36              
37             =head1 DESCRIPTION
38              
39             Log::Fine provides a logging framework for application developers
40             who need a fine-grained logging mechanism in their program(s). By
41             itself, Log::Fine provides a mechanism to get one or more logging
42             objects (called I) from its stored namespace. Most logging
43             is then done through a logger object that is specific to the
44             application.
45              
46             For a simple functional interface to the logging sub-system, see
47             L.
48              
49             =head2 Handles
50              
51             Handlers provides a means to output log messages in one or more
52             ways. Currently, the following handles are provided:
53              
54             =over 4
55              
56             =item * L
57              
58             Provides logging to C or C
59              
60             =item * L
61              
62             Provides logging via email. Useful for delivery to one or more pager
63             addresses.
64              
65             =item * L
66              
67             Provides logging to a file
68              
69             =item * L
70              
71             Same thing with support for time-stamped files
72              
73             =item * L
74              
75             Provides logging to L
76              
77             =back
78              
79             See the relevant perldoc information for more information. Additional
80             handlers can be defined to user taste.
81              
82             =cut
83              
84 19     19   592732 use strict;
  19         57  
  19         875  
85 19     19   112 use warnings;
  19         42  
  19         1570  
86              
87             package Log::Fine;
88              
89             require 5.008003;
90              
91 19     19   118 use Carp qw( cluck confess );
  19         48  
  19         1346  
92 19     19   15111 use Log::Fine::Levels;
  19         211  
  19         2658  
93 19     19   13264 use Log::Fine::Logger;
  19         56  
  19         1063  
94 19     19   22765 use POSIX qw( strftime );
  19         211647  
  19         642  
95              
96             our $VERSION = '0.64';
97              
98             =head2 Formatters
99              
100             A formatter specifies how Log::Fine displays messages. When a message
101             is logged, it gets passed through a formatter object, which adds any
102             additional information such as a time-stamp or caller information.
103              
104             By default, log messages are formatted as follows using the
105             L formatter object.
106              
107             [
108              
109             For more information on the customization of log messages, see
110             L.
111              
112             =head1 INSTALLATION
113              
114             To install Log::Fine:
115              
116             perl Makefile.PL
117             make
118             make test
119             make install
120              
121             =cut
122              
123             # Private Methods
124             # --------------------------------------------------------------------
125              
126             {
127              
128             # Private global variables
129             my $levelmap;
130             my $loggers = {};
131             my $objcount = 0;
132              
133             # Getter/setter for levelMap. Note that levelMap can only be
134             # set _once_. Once levelmap is set, any other value passed,
135             # whether a valid object or not, will be ignored!
136             sub _levelMap
137             {
138              
139 3381     3381   7950 my $map = shift;
140              
141 3381 100 66     25474 if ( defined $map
    50 66        
      33        
      33        
      33        
142             and ref $map
143             and UNIVERSAL::can($map, 'isa')
144             and $map->isa("Log::Fine::Levels")
145             and not $levelmap) {
146 16         41 $levelmap = $map;
147             } elsif (defined $map and not $levelmap) {
148 0   0     0 _fatal(
149             sprintf("Invalid Value: \"%s\"",
150             $map || "{undef}"));
151             }
152              
153 3381         33796 return $levelmap;
154              
155             } # _levelMap()
156              
157 43     43   431 sub _logger { return $loggers }
158 827     827   3883 sub _objectCount { return $objcount }
159 834     834   1410 sub _incrObjectCount { return ++$objcount }
160              
161             }
162              
163             # --------------------------------------------------------------------
164              
165             =head1 METHODS
166              
167             The Log::Fine module, by itself, provides getters & setter methods for
168             loggers and level classes. After a logger is created, further actions
169             are done through the logger object. The following two constructors
170             are defined:
171              
172             =head2 new
173              
174             Creates a new Log::Fine object.
175              
176             =head3 Parameters
177              
178             A hash with the following keys
179              
180             =over
181              
182             =item * levelmap
183              
184             [default: Syslog] Name of level map to use. See L
185             for further details
186              
187             =item * no_croak
188              
189             [optional] If set to true, then do not L when
190             L<_error> is called.
191              
192             =item * err_callback
193              
194             [optional] If defined to a valid CODE ref, then this subroutine will
195             be called instead of L<_fatal> when L<_error> is called.
196              
197             =back
198              
199             =head3 Returns
200              
201             The newly blessed object
202              
203             =cut
204              
205             sub new
206             {
207              
208 845     845 1 71789 my $class = shift;
209 845         2706 my %h = @_;
210              
211             # Bless the hash into a class
212 845         3649 my $self = bless \%h, $class;
213              
214             # Perform any necessary initializations
215 845         4616 $self->_init();
216              
217 840         2857 return $self;
218              
219             } # new()
220              
221             =head2 listLoggers
222              
223             Provides list of currently defined loggers
224              
225             =head3 Parameters
226              
227             None
228              
229             =head3 Returns
230              
231             Array containing list of currently defined loggers
232              
233             =cut
234              
235 8     8 1 22 sub listLoggers { return keys %{ _logger() } }
  8         31  
236              
237             =head2 levelMap
238              
239             Getter for the global level map.
240              
241             =head3 Returns
242              
243             A L subclass
244              
245             =cut
246              
247 81     81 1 10014 sub levelMap { return _levelMap() }
248              
249             =head2 logger
250              
251             Getter/Constructor for a logger object.
252              
253             =head3 Parameters
254              
255             =over
256              
257             =item * logger name
258              
259             The name of the logger object. If the specified logger object does
260             not exist, then a new one will be created.
261              
262             =back
263              
264             =head3 Returns
265              
266             an L object
267              
268             =cut
269              
270             sub logger
271             {
272              
273 11     11 1 25743 my $self = shift;
274 11         30 my $name = shift; # name of logger
275              
276             # Validate name
277 11 50 33     144 $self->_fatal("First parameter must be a valid name!")
278             unless (defined $name and $name =~ /\w/);
279              
280             # Should the requested logger be found, then return it,
281             # otherwise store and return a newly created logger object
282             # with the given name
283 11 50 66     57 _logger()->{$name} = Log::Fine::Logger->new(name => $name)
      66        
      33        
284             unless ( defined _logger()->{$name}
285             and ref _logger()->{$name}
286             and UNIVERSAL::can(_logger()->{$name}, 'isa')
287             and _logger()->{$name}->isa('Log::Fine::Logger'));
288              
289 11         40 return _logger()->{$name};
290              
291             } # logger()
292              
293             =head2 name
294              
295             Getter for name of object
296              
297             =head3 Parameters
298              
299             None
300              
301             =head3 Returns
302              
303             String containing name of object, otherwise undef
304              
305             =cut
306              
307 44   50 44 1 117227 sub name { return $_[0]->{name} || undef }
308              
309             # --------------------------------------------------------------------
310              
311             =head2 _error
312              
313             Private internal method that is called when an error condition is
314             encountered. Will call L<_fatal> unless C<{no_croak}> is defined.
315              
316             This method can be overridden per taste.
317              
318             =head3 Parameters
319              
320             =over
321              
322             =item message
323              
324             Message passed to L.
325              
326             =back
327              
328             =cut
329              
330             sub _error
331             {
332 2     2   5 my $self;
333             my $msg;
334              
335             # How were we called?
336 2 50       6 if (scalar @_ > 1) {
337 2         3 $self = shift;
338 2         5 $msg = shift;
339             } else {
340 0         0 $msg = shift;
341             }
342              
343 2 50 33     33 if ( defined $self
      33        
      33        
344             and ref $self
345             and UNIVERSAL::can($self, 'isa')
346             and $self->isa("Log::Fine")) {
347              
348 2 50 33     13 if (defined $self->{err_callback}
    0          
349             and ref $self->{err_callback} eq "CODE") {
350 2         3 &{ $self->{err_callback} }($msg);
  2         8  
351             } elsif ($self->{no_croak}) {
352 0         0 $self->{_err_msg} = $msg;
353 0         0 cluck $msg;
354             } else {
355 0         0 $self->_fatal($msg);
356             }
357              
358             } else {
359 0         0 _fatal($msg);
360             }
361              
362             }
363              
364             =head2 _fatal
365              
366             Private internal method that is called when a fatal (non-recoverable)
367             condition is encountered. Calls L with given error
368             message.
369              
370             While this method can be overridden, this is generally not advised.
371              
372             =head3 Parameters
373              
374             =over
375              
376             =item message
377              
378             Message passed to L.
379              
380             =back
381              
382             =cut
383              
384             sub _fatal
385             {
386              
387 10     10   26 my $self;
388             my $msg;
389              
390             # How were we called?
391 10 50       47 if (scalar @_ > 1) {
392 10         19 $self = shift;
393 10         25 $msg = shift;
394             } else {
395 0         0 $msg = shift;
396             }
397              
398 10         2302 confess $msg;
399              
400             #
401             # NOT REACHED
402             #
403              
404             } # _fatal()
405              
406             ##
407             # Initializes our object
408              
409             sub _init
410             {
411              
412 834     834   1321 my $self = shift;
413              
414 834         2141 _incrObjectCount();
415              
416             # We set the objects name unless it is already set for us
417 834 100 66     4050 unless (defined $self->{name} and $self->{name} =~ /\w/) {
418              
419             # grab the class name
420 827         2677 $self->{name} = ref $self;
421 827         6866 $self->{name} =~ /\:(\w+)$/;
422 827         4830 $self->{name} = lc($+) . _objectCount();
423              
424             }
425              
426             # Validate {err_callback}
427 834 100       2747 if (defined $self->{err_callback}) {
428 2 100       11 $self->_fatal("{err_callback} must be a valid code ref")
429             unless ref $self->{err_callback} eq "CODE";
430             }
431              
432             # Set our levels if we need to
433 833 50 66     1836 _levelMap(Log::Fine::Levels->new($self->{levelmap}))
      66        
      33        
434             unless ( defined _levelMap()
435             and ref _levelMap()
436             and UNIVERSAL::can(_levelMap(), 'isa')
437             and _levelMap()->isa("Log::Fine::Levels"));
438              
439 833         3750 return $self;
440              
441             } # _init()
442              
443             # is "Python" a dirty word in perl POD documentation? Oh well.
444              
445             =head1 ACKNOWLEDGMENTS
446              
447             I'd like the thank the following people for either inspiration or past
448             work on logging: Josh Glover for his work as well as teaching me all I
449             know about object-oriented programming in perl. Dan Boger for taking
450             the time and patience to review this code and offer his own
451             suggestions. Additional thanks to Tom Maher and Chris Josephs for
452             encouragement.
453              
454             =head2 Related Modules/Frameworks
455              
456             The following logging frameworks provided inspiration for parts of Log::Fine.
457              
458             =over 4
459              
460             =item
461              
462             Dave Rolsky's L module
463              
464             =item
465              
466             Sun Microsystem's C framework
467              
468             =item
469              
470             The Python logging package
471              
472             =back
473              
474             =head1 BUGS
475              
476             Please report any bugs or feature requests to
477             C, or through the web interface at
478             L.
479             I will be notified, and then you'll automatically be notified of progress on
480             your bug as I make changes.
481              
482             =head1 SUPPORT
483              
484             You can find documentation for this module with the perldoc command.
485              
486             perldoc Log::Fine
487              
488             You can also look for information at:
489              
490             =over 4
491              
492             =item * AnnoCPAN: Annotated CPAN documentation
493              
494             L
495              
496             =item * CPAN Ratings
497              
498             L
499              
500             =item * RT: CPAN's request tracker
501              
502             L
503              
504             =item * Search CPAN
505              
506             L
507              
508             =back
509              
510             =head1 CONTRIBUTING
511              
512             Want to contribute? The source code repository for Log::Fine is now
513             available at L. To clone your
514             own copy:
515              
516             $ git clone git://github.com/cfuhrman/log-fine.git
517              
518             Signed patches generated by L(1) may be submitted
519             L.
520              
521             =head1 AUTHOR
522              
523             Christopher M. Fuhrman, C<< >>
524              
525             =head1 SEE ALSO
526              
527             L, L, L, L,
528             L, L, L
529              
530             =head1 COPYRIGHT & LICENSE
531              
532             Copyright (c) 2008-2011, 2013 Christopher M. Fuhrman,
533             All rights reserved.
534              
535             This program is free software licensed under the...
536              
537             The BSD License
538              
539             The full text of the license can be found in the
540             LICENSE file included with this module.
541              
542             =cut
543              
544             1; # End of Log::Fine