File Coverage

blib/lib/Log/Fine/Logger.pm
Criterion Covered Total %
statement 49 49 100.0
branch 16 18 88.8
condition 26 42 61.9
subroutine 11 11 100.0
pod 5 5 100.0
total 107 125 85.6


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Log::Fine::Logger - Main logging object
5              
6             =head1 SYNOPSIS
7              
8             Provides an object through which to log.
9              
10             use Log::Fine;
11             use Log::Fine::Logger;
12              
13             # Get a new logging object
14             my $log = Log::Fine->logger("mylogger");
15              
16             # Alternatively, specify a custom map
17             my $log = Log::Fine->logger("mylogger", "Syslog");
18              
19             # Register a handle
20             $log->registerHandle( Log::Fine::Handle::Console->new() );
21              
22             # Log a message
23             $log->log(DEBG, "This is a really cool module!");
24              
25             # Illustrate use of the log skip API
26             package Some::Package::That::Overrides::Log::Fine::Logger;
27              
28             use base qw( Log::Fine::Logger );
29              
30             sub log
31             {
32             my $self = shift;
33             my $lvl = shift;
34             my $msg = shift;
35              
36             # Do some custom stuff to message
37              
38             # Make sure the formatter logs the correct calling method.
39             $self->incrSkip();
40             $self->SUPER::log($lvl, $msg);
41             $self->decrSkip();
42              
43             } # log()
44              
45             =head1 DESCRIPTION
46              
47             The Logger class is the main workhorse of the Log::Fine framework,
48             providing the main L method from which to log. In addition,
49             the Logger class provides means by which the developer can control the
50             parameter passed to any caller() call so information regarding the
51             correct stack frame is displayed.
52              
53             =cut
54              
55 19     19   64 use strict;
  19         21  
  19         420  
56 19     19   54 use warnings;
  19         17  
  19         529  
57              
58             package Log::Fine::Logger;
59              
60 19     19   61 use base qw( Log::Fine );
  19         20  
  19         1399  
61              
62 19     19   72 use Log::Fine;
  19         22  
  19         557  
63              
64             our $VERSION = $Log::Fine::VERSION;
65              
66             # Constant: LOG_SKIP_DEFAULT
67             #
68             # By default, calls to caller() will be given a stack frame of 2.
69              
70 19     19   59 use constant LOG_SKIP_DEFAULT => 2;
  19         20  
  19         8993  
71              
72             # --------------------------------------------------------------------
73              
74             =head2 decrSkip
75              
76             Decrements the value of the skip attribute by one
77              
78             =head3 Returns
79              
80             The newly decremented value
81              
82             =cut
83              
84 4     4 1 8 sub decrSkip { return --$_[0]->{_skip}; } # decrSkip()
85              
86             =head2 incrSkip
87              
88             Increments the value of the skip attribute by one
89              
90             =head3 Returns
91              
92             The newly incremented value
93              
94             =cut
95              
96 4     4 1 283 sub incrSkip { return ++$_[0]->{_skip}; } # incrSkip()
97              
98             =head2 log
99              
100             Logs the message at the given log level
101              
102             =head3 Parameters
103              
104             =over
105              
106             =item * level
107              
108             Level at which to log
109              
110             =item * message
111              
112             Message to log
113              
114             =back
115              
116             =head3 Returns
117              
118             The object
119              
120             =cut
121              
122             sub log
123             {
124              
125 10     10 1 12 my $self = shift;
126 10         12 my $lvl = shift;
127 10         11 my $msg = shift;
128              
129             # See if we have any handles defined
130             $self->_fatal("No handles defined!")
131             unless ( defined $self->{_handles}
132             and ref $self->{_handles} eq "ARRAY"
133 10 50 66     59 and scalar @{ $self->{_handles} } > 0);
  9   66     30  
134              
135             # Iterate through each handle, logging as appropriate
136 9         12 foreach my $handle (@{ $self->{_handles} }) {
  9         22  
137             $handle->msgWrite($lvl, $msg, $self->{_skip})
138 9 100       40 if $handle->isLoggable($lvl);
139             }
140              
141 9         1207 return $self;
142              
143             } # log()
144              
145             =head2 registerHandle
146              
147             Register one or more L objects with the logging
148             facility.
149              
150             =head3 Parameters
151              
152             =over
153              
154             =item * handle
155              
156             Can either be a valid Log::Fine::Handle object or an array ref
157             containing one or more Log::Fine::Handle objects
158              
159             =back
160              
161             =head3 Returns
162              
163             The object
164              
165             =cut
166              
167             sub registerHandle
168             {
169              
170 7     7 1 2617 my $self = shift;
171 7         7 my $obj = shift;
172              
173             # Initialize handles if we haven't already
174             $self->{_handles} = []
175             unless (defined $self->{_handles}
176 7 100 66     34 and ref $self->{_handles} eq "ARRAY");
177              
178 7 100 66     106 if ( defined $obj
    100 100        
      66        
      66        
      66        
179             and ref $obj
180             and UNIVERSAL::can($obj, 'isa')
181             and $obj->isa('Log::Fine::Handle')) {
182 3         4 push @{ $self->{_handles} }, $obj;
  3         8  
183 3         10 } elsif (defined $obj and ref $obj eq 'ARRAY' and scalar @{$obj} > 0) {
184              
185 3         3 foreach my $handle (@{$obj}) {
  3         9  
186 4 100 33     53 $self->_fatal("Array ref must contain valid " . "Log::Fine::Handle objects")
      33        
      66        
187             unless ( defined $handle
188             and ref $handle
189             and UNIVERSAL::can($handle, 'isa')
190             and $handle->isa('Log::Fine::Handle'));
191             }
192              
193 2         2 push @{ $self->{_handles} }, @{$obj};
  2         3  
  2         4  
194              
195             } else {
196 1         3 $self->_fatal( "first argument must either be a "
197             . "valid Log::Fine::Handle object\n"
198             . "or an array ref containing one or more "
199             . "valid Log::Fine::Handle objects\n");
200             }
201              
202 5         12 return $self;
203              
204             } # registerHandle()
205              
206             =head2 skip
207              
208             Getter/Setter for the objects skip attribute
209              
210             See L for details
211              
212             =head3 Returns
213              
214             The objects skip attribute
215              
216             =cut
217              
218             sub skip
219             {
220              
221 3     3 1 625 my $self = shift;
222 3         3 my $val = shift;
223              
224             # Should we be given a value, then set skip
225 3 100 66     14 $self->{_skip} = $val
226             if (defined $val and $val =~ /^\d+$/);
227              
228 3         5 return $self->{_skip};
229              
230             } # skip()
231              
232             # --------------------------------------------------------------------
233              
234             ##
235             # Initializes our object
236              
237             sub _init
238             {
239              
240 11     11   16 my $self = shift;
241              
242             # Validate name
243             $self->_fatal("Loggers need names!")
244 11 100 66     135 unless (defined $self->{name} and $self->{name} =~ /^\w+$/);
245              
246             # Set logskip if necessary
247             $self->{_skip} = LOG_SKIP_DEFAULT
248 10 50 33     51 unless ($self->{_skip} and $self->{_skip} =~ /\d+/);
249              
250 10         20 return $self;
251              
252             } # _init()
253              
254             =head1 BUGS
255              
256             Please report any bugs or feature requests to
257             C, or through the web interface at
258             L.
259             I will be notified, and then you'll automatically be notified of progress on
260             your bug as I make changes.
261              
262             =head1 SUPPORT
263              
264             You can find documentation for this module with the perldoc command.
265              
266             perldoc Log::Fine
267              
268             You can also look for information at:
269              
270             =over 4
271              
272             =item * AnnoCPAN: Annotated CPAN documentation
273              
274             L
275              
276             =item * CPAN Ratings
277              
278             L
279              
280             =item * RT: CPAN's request tracker
281              
282             L
283              
284             =item * Search CPAN
285              
286             L
287              
288             =back
289              
290             =head1 AUTHOR
291              
292             Christopher M. Fuhrman, C<< >>
293              
294             =head1 SEE ALSO
295              
296             L, L, L
297              
298             =head1 COPYRIGHT & LICENSE
299              
300             Copyright (c) 2008, 2010, 2013 Christopher M. Fuhrman,
301             All rights reserved
302              
303             This program is free software licensed under the...
304              
305             The BSD License
306              
307             The full text of the license can be found in the
308             LICENSE file included with this module.
309              
310             =cut
311              
312             1; # End of Log::Fine::Logger