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   1466 use strict;
  2         2  
  2         41  
66 2     2   6 use warnings;
  2         2  
  2         78  
67              
68             package Log::Fine::Utils;
69              
70             our @ISA = qw( Exporter );
71              
72             #use Data::Dumper;
73              
74 2     2   7 use Log::Fine;
  2         2  
  2         32  
75 2     2   6 use Log::Fine::Levels;
  2         2  
  2         46  
76 2     2   8 use Log::Fine::Logger;
  2         2  
  2         890  
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   64 $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         85 return $logfine;
101             }
102              
103             # Getter/Setter for current logger
104             sub _logger
105             {
106 23 50 66 23   64 $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         60 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 208 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 641 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 4 my $lvl = shift;
186 3         3 my $msg = shift;
187 3         4 my $log = _logger();
188              
189             # Validate logger has been set
190 3 50 33     32 Log::Fine->_fatal("Logging system has not been set up " . "(See Log::Fine::Utils::OpenLog())")
      33        
      33        
191             unless ( defined $log
192             and ref $log
193             and UNIVERSAL::can($log, 'isa')
194             and $log->isa("Log::Fine::Logger"));
195              
196             # Make sure we log the correct calling method
197 3         9 $log->incrSkip();
198 3         8 $log->log($lvl, $msg);
199 3         8 $log->decrSkip();
200              
201 3         7 return 1;
202              
203             } # Log()
204              
205             =head2 OpenLog
206              
207             Opens the logging subsystem. If called with the name of a previously
208             defined logger object, will switch to that logger, ignoring other
209             given hash elements.
210              
211             =head3 Parameters
212              
213             A hash containing the following keys:
214              
215             =over
216              
217             =item * handles
218              
219             Either a single L object or an array ref containing
220             one or more L objects
221              
222             =item * levelmap
223              
224             B<[optional]> L subclass to use. Will default to
225             "Syslog" if not defined.
226              
227             =item * name
228              
229             B<[optional]> Name of logger. If name references an already
230             registered logger, then will switch to the named logger. Should the
231             given name not exist, then will create a new logging object with that
232             name, provided handles are provided. Should name not be passed, then
233             'GENERIC' will be used. Note that you I provide one or more
234             valid handles when creating a new object.
235              
236             =item * no_croak
237              
238             [default: 0] If true, Log::Fine will not croak under certain
239             circumstances (see L)
240              
241             =back
242              
243             =head3 Returns
244              
245             1 on success
246              
247             =cut
248              
249             sub OpenLog
250             {
251              
252 3     3 1 10 my %data = @_;
253              
254             # Set name to a default value if need be
255             $data{name} = "GENERIC"
256 3 100 66     23 unless (defined $data{name} and $data{name} =~ /\w/);
257              
258             # Should no Log::Fine object be defined, generate one
259             _logfine(
260             Log::Fine->new(name => "Utils",
261             levelmap => $data{levelmap} || Log::Fine::Levels->DEFAULT_LEVELMAP,
262 3 50 33     3 no_croak => $data{no_croak} || 0
      50        
      66        
      66        
      33        
263             ))
264             unless ( defined _logfine()
265             and ref _logfine()
266             and UNIVERSAL::can(_logfine(), 'isa')
267             and _logfine()->isa('Log::Fine'));
268              
269             # See if we have the given logger name
270 3 100 66     5 if ( defined _logger
      66        
      33        
      33        
      33        
      66        
271             and ref _logger()
272             and UNIVERSAL::can(_logger(), 'isa')
273             and _logger()->isa('Log::Fine::Logger')
274             and defined _logger()->name()
275             and _logger()->name() =~ /\w/
276             and grep(/$data{name}/, ListLoggers())) {
277              
278             # Set the current logger to the given name
279 1         2 _logger(_logfine()->logger($data{name}));
280              
281             } else {
282              
283             # Create logger, register handle(s), and store for
284             # future use.
285 2         3 my $logger = _logfine()->logger($data{name});
286              
287             # Note that registerHandle() will take care of handle
288             # validation.
289 2         7 $logger->registerHandle($data{handles});
290 2         3 _logger($logger);
291              
292             }
293              
294 3         7 return 1;
295              
296             } # OpenLog()
297              
298             =head1 BUGS
299              
300             Please report any bugs or feature requests to
301             C, or through the web interface at
302             L.
303             I will be notified, and then you'll automatically be notified of progress on
304             your bug as I make changes.
305              
306             =head1 CAVEATS
307              
308             OpenLog() will croak regardless if C<{no_croak}> is set if the
309             following two conditions are met:
310              
311             =over
312              
313             =item * OpenLog() is passed the name of an unknown logger, thus
314             necessitating the creation of a new logger object
315              
316             =item * No L objects were passed in the
317             C<{handles}> array
318              
319             =back
320              
321             =head1 SUPPORT
322              
323             You can find documentation for this module with the perldoc command.
324              
325             perldoc Log::Fine
326              
327             You can also look for information at:
328              
329             =over 4
330              
331             =item * AnnoCPAN: Annotated CPAN documentation
332              
333             L
334              
335             =item * CPAN Ratings
336              
337             L
338              
339             =item * RT: CPAN's request tracker
340              
341             L
342              
343             =item * Search CPAN
344              
345             L
346              
347             =back
348              
349             =head1 AUTHOR
350              
351             Christopher M. Fuhrman, C<< >>
352              
353             =head1 SEE ALSO
354              
355             L, L, L, L
356              
357             =head1 COPYRIGHT & LICENSE
358              
359             Copyright (c) 2008, 2010-2011, 2013 Christopher M. Fuhrman,
360             All rights reserved
361              
362             This program is free software licensed under the...
363              
364             The BSD License
365              
366             The full text of the license can be found in the
367             LICENSE file included with this module.
368              
369             =cut
370              
371             1; # End of Log::Fine::Utils