File Coverage

blib/lib/Log/Fine/Utils.pm
Criterion Covered Total %
statement 38 38 100.0
branch 10 14 71.4
condition 31 62 50.0
subroutine 11 11 100.0
pod 4 4 100.0
total 94 129 72.8


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Log::Fine::Utils - Functional wrapper around Log::Fine
5              
6             =head1 SYNOPSIS
7              
8             Provides a functional wrapper around Log::Fine.
9              
10             use Log::Fine::Handle;
11             use Log::Fine::Handle::File;
12             use Log::Fine::Handle::Syslog;
13             use Log::Fine::Levels::Syslog;
14             use Log::Fine::Utils;
15             use Sys::Syslog;
16              
17             # Set up some handles as you normally would. First, a handler for
18             # file logging:
19             my $handle1 = Log::Fine::Handle::File
20             ->new( name => "file0",
21             mask => Log::Fine::Levels::Syslog->bitmaskAll(),
22             formatter => Log::Fine::Formatter::Basic->new() );
23              
24             # And now a handle for syslog
25             my $handle2 = Log::Fine::Handle::Syslog
26             ->new( name => "syslog0",
27             mask => LOGMASK_EMERG | LOGMASK_CRIT | LOGMASK_ERR,
28             ident => $0,
29             logopts => 'pid',
30             facility => LOG_LEVEL0 );
31              
32             # Open the logging subsystem with the default name "GENERIC"
33             OpenLog( handles => [ $handle1, [$handle2], ... ],
34             levelmap => "Syslog" );
35              
36             # Open new logging object with name "aux". Note this will switch
37             # the current logger to "aux"
38             OpenLog( name => "aux",
39             handles => [ $handle1, [[$handle2], [...] ]],
40             levelmap => "Syslog" );
41              
42             # Grab a ref to active logger
43             my $current_logger = CurrentLogger();
44              
45             # Get name of current logger
46             my $loggername = $current_logger()->name();
47              
48             # Switch back to GENERIC logger
49             OpenLog( name => "GENERIC" );
50              
51             # Grab a list of defined logger names
52             my @names = ListLoggers();
53              
54             # Log a message
55             Log( INFO, "The angels have my blue box" );
56              
57             =head1 DESCRIPTION
58              
59             The Utils class provides a functional wrapper for L and
60             friends, thus saving the developer the tedious task of mucking about
61             in object-oriented land.
62              
63             =cut
64              
65 2     2   3903 use strict;
  2         3  
  2         85  
66 2     2   11 use warnings;
  2         6  
  2         135  
67              
68             package Log::Fine::Utils;
69              
70             our @ISA = qw( Exporter );
71              
72             #use Data::Dumper;
73              
74 2     2   13 use Log::Fine;
  2         4  
  2         64  
75 2     2   12 use Log::Fine::Levels;
  2         4  
  2         97  
76 2     2   11 use Log::Fine::Logger;
  2         5  
  2         2075  
77              
78             our $VERSION = $Log::Fine::VERSION;
79              
80             # Exported functions
81             our @EXPORT = qw( CurrentLogger ListLoggers Log OpenLog );
82              
83             # Private Functions
84             # --------------------------------------------------------------------
85              
86             {
87              
88             my $logfine = undef; # Log::Fine object
89             my $logger = undef; # Ptr to current logger
90              
91             # Getter/Setter for Log::Fine object
92             sub _logfine
93             {
94 28 50 66 28   1727 $logfine = $_[0]
      66        
      33        
95             if ( defined $_[0]
96             and ref $_[0]
97             and UNIVERSAL::can($_[0], 'isa')
98             and $_[0]->isa('Log::Fine'));
99              
100 28         206 return $logfine;
101             }
102              
103             # Getter/Setter for current logger
104             sub _logger
105             {
106 23 50 66 23   135 $logger = $_[0]
      66        
      33        
107             if ( defined $_[0]
108             and ref $_[0]
109             and UNIVERSAL::can($_[0], 'isa')
110             and $_[0]->isa('Log::Fine::Logger'));
111              
112 23         486 return $logger;
113             }
114              
115             }
116              
117             =head1 FUNCTIONS
118              
119             The following functions are automatically exported by
120             Log::Fine::Utils:
121              
122             =head2 CurrentLogger
123              
124             Returns the currently "active" L object
125              
126             =head3 Parameters
127              
128             None
129              
130             =head3 Returns
131              
132             Currently active L object
133              
134             =cut
135              
136 4     4 1 2664 sub CurrentLogger { return _logger(); }
137              
138             =head2 ListLoggers
139              
140             Provides list of currently defined loggers
141              
142             =head3 Parameters
143              
144             None
145              
146             =head3 Returns
147              
148             Array containing list of currently defined loggers or undef if no
149             loggers are defined
150              
151             =cut
152              
153             sub ListLoggers
154             {
155 8 100   8 1 4082 return (defined _logfine()) ? _logfine()->listLoggers() : ();
156             }
157              
158             =head2 Log
159              
160             Logs the message at the given log level
161              
162             =head3 Parameters
163              
164             =over
165              
166             =item * level
167              
168             Level at which to log
169              
170             =item * message
171              
172             Message to log
173              
174             =back
175              
176             =head3 Returns
177              
178             1 on success
179              
180             =cut
181              
182             sub Log
183             {
184              
185 3     3 1 10 my $lvl = shift;
186 3         10 my $msg = shift;
187 3         14 my $log = _logger();
188              
189             # Validate logger has been set
190 3 50 33     74 Log::Fine->_fatal( "Logging system has not been set up "
      33        
      33        
191             . "(See Log::Fine::Utils::OpenLog())")
192             unless ( defined $log
193             and ref $log
194             and UNIVERSAL::can($log, 'isa')
195             and $log->isa("Log::Fine::Logger"));
196              
197             # Make sure we log the correct calling method
198 3         21 $log->incrSkip();
199 3         20 $log->log($lvl, $msg);
200 3         16 $log->decrSkip();
201              
202 3         18 return 1;
203              
204             } # Log()
205              
206             =head2 OpenLog
207              
208             Opens the logging subsystem. If called with the name of a previously
209             defined logger object, will switch to that logger, ignoring other
210             given hash elements.
211              
212             =head3 Parameters
213              
214             A hash containing the following keys:
215              
216             =over
217              
218             =item * handles
219              
220             Either a single L object or an array ref containing
221             one or more L objects
222              
223             =item * levelmap
224              
225             B<[optional]> L subclass to use. Will default to
226             "Syslog" if not defined.
227              
228             =item * name
229              
230             B<[optional]> Name of logger. If name references an already
231             registered logger, then will switch to the named logger. Should the
232             given name not exist, then will create a new logging object with that
233             name, provided handles are provided. Should name not be passed, then
234             'GENERIC' will be used. Note that you I provide one or more
235             valid handles when creating a new object.
236              
237             =item * no_croak
238              
239             [default: 0] If true, Log::Fine will not croak under certain
240             circumstances (see L)
241              
242             =back
243              
244             =head3 Returns
245              
246             1 on success
247              
248             =cut
249              
250             sub OpenLog
251             {
252              
253 3     3 1 36 my %data = @_;
254              
255             # Set name to a default value if need be
256 3 100 66     32 $data{name} = "GENERIC"
257             unless (defined $data{name} and $data{name} =~ /\w/);
258              
259             # Should no Log::Fine object be defined, generate one
260 3 50 33     15 _logfine(
      50        
      66        
      66        
      33        
261             Log::Fine->new(name => "Utils",
262             levelmap => $data{levelmap}
263             || Log::Fine::Levels->DEFAULT_LEVELMAP,
264             no_croak => $data{no_croak} || 0
265             ))
266             unless ( defined _logfine()
267             and ref _logfine()
268             and UNIVERSAL::can(_logfine(), 'isa')
269             and _logfine()->isa('Log::Fine'));
270              
271             # See if we have the given logger name
272 3 100 66     11 if ( defined _logger
      66        
      33        
      33        
      33        
      66        
273             and ref _logger()
274             and UNIVERSAL::can(_logger(), 'isa')
275             and _logger()->isa('Log::Fine::Logger')
276             and defined _logger()->name()
277             and _logger()->name() =~ /\w/
278             and grep(/$data{name}/, ListLoggers())) {
279              
280             # Set the current logger to the given name
281 1         5 _logger(_logfine()->logger($data{name}));
282              
283             } else {
284              
285             # Create logger, register handle(s), and store for
286             # future use.
287 2         7 my $logger = _logfine()->logger($data{name});
288              
289             # Note that registerHandle() will take care of handle
290             # validation.
291 2         12 $logger->registerHandle($data{handles});
292 2         6 _logger($logger);
293              
294             }
295              
296 3         15 return 1;
297              
298             } # OpenLog()
299              
300             =head1 BUGS
301              
302             Please report any bugs or feature requests to
303             C, or through the web interface at
304             L.
305             I will be notified, and then you'll automatically be notified of progress on
306             your bug as I make changes.
307              
308             =head1 CAVEATS
309              
310             OpenLog() will croak regardless if C<{no_croak}> is set if the
311             following two conditions are met:
312              
313             =over
314              
315             =item * OpenLog() is passed the name of an unknown logger, thus
316             necessitating the creation of a new logger object
317              
318             =item * No L objects were passed in the
319             C<{handles}> array
320              
321             =back
322              
323             =head1 SUPPORT
324              
325             You can find documentation for this module with the perldoc command.
326              
327             perldoc Log::Fine
328              
329             You can also look for information at:
330              
331             =over 4
332              
333             =item * AnnoCPAN: Annotated CPAN documentation
334              
335             L
336              
337             =item * CPAN Ratings
338              
339             L
340              
341             =item * RT: CPAN's request tracker
342              
343             L
344              
345             =item * Search CPAN
346              
347             L
348              
349             =back
350              
351             =head1 AUTHOR
352              
353             Christopher M. Fuhrman, C<< >>
354              
355             =head1 SEE ALSO
356              
357             L, L, L, L
358              
359             =head1 COPYRIGHT & LICENSE
360              
361             Copyright (c) 2008, 2010-2011, 2013 Christopher M. Fuhrman,
362             All rights reserved
363              
364             This program is free software licensed under the...
365              
366             The BSD License
367              
368             The full text of the license can be found in the
369             LICENSE file included with this module.
370              
371             =cut
372              
373             1; # End of Log::Fine::Utils