File Coverage

blib/lib/Net/SolarWinds/Log.pm
Criterion Covered Total %
statement 96 98 97.9
branch 17 20 85.0
condition 3 3 100.0
subroutine 28 29 96.5
pod 12 14 85.7
total 156 164 95.1


line stmt bran cond sub pod time code
1             package Net::SolarWinds::Log;
2            
3             =pod
4            
5             =head1 NAME
6            
7             Net::SolarWinds::Log - Simple file logging module
8            
9             =head1 SYNOPSIS
10            
11             use Net::SolarWinds::Log;
12            
13             my $log=new Net::SolarWinds::Log('/some/log/file.log');
14            
15             $log->log_info("This will not be logged");
16             $log->log_error("This will be logged");
17            
18             $log->set_loglevel(Net::SolarWinds::Log->LOG_INFO);
19            
20             $log->log_info("This will now be logged");
21             $log->log_error("This will still be logged");
22            
23            
24            
25             =head1 DESCRIPTION
26            
27             This package provides a very simple somewhat standardized logging interface. The module itself extends Net::SolarWinds::FileRotationBase and inherits all of its features.
28            
29             =cut
30            
31 4     4   18550 use strict;
  4         14  
  4         169  
32 4     4   35 use warnings;
  4         14  
  4         204  
33 4     4   35 use base qw(Net::SolarWinds::FileRotationBase);
  4         24  
  4         2759  
34 4     4   41 use File::Basename qw(basename);
  4         12  
  4         315  
35 4     4   35 use Scalar::Util qw(looks_like_number);
  4         10  
  4         290  
36 4     4   2616 use Sys::Hostname;
  4         6425  
  4         314  
37 4     4   45 use Carp qw(croak);
  4         13  
  4         374  
38             require Exporter;
39            
40             our @EXPORT_OK = (qw(LOG_NONE LOG_ERROR LOG_WARN LOG_INFO LOG_DEBUG));
41            
42 4     4   44 use constant LOOK_BACK_DEPTH => 4;
  4         14  
  4         406  
43            
44             =head1 Exports
45            
46             The following constants can be exported using the standard exporter syntax
47            
48             use Net::SolarWinds::Log (qw(LOG_NONE LOG_ERROR LOG_WARN LOG_INFO LOG_DEBUG));
49            
50             =cut
51            
52 4     4   54 use constant LOG_NONE => -1;
  4         16  
  4         259  
53 4     4   33 use constant LOG_ALWAYS => 0;
  4         12  
  4         240  
54 4     4   41 use constant LOG_ERROR => 1;
  4         12  
  4         231  
55 4     4   31 use constant LOG_WARN => 2;
  4         14  
  4         252  
56 4     4   35 use constant LOG_INFO => 3;
  4         15  
  4         389  
57 4     4   32 use constant LOG_DEBUG => 4;
  4         11  
  4         238  
58            
59             =head2 Default Log level
60            
61             The default log level is LOG_ERROR or 1. In the default state only errors are logged.
62            
63             =cut
64            
65 4     4   31 use constant DEFAULT_LOG_LEVEL => 1;
  4         11  
  4         4213  
66            
67             =head1 OO Methods
68            
69             =over 3
70            
71             =item * Object constructor
72            
73             The object constructor takes key=>'value' argument pairs example:
74            
75             my $log=new Net::SolarWinds::Log(
76             filename=>'/full/path/to/file.log',
77             loglevel=>4,
78            
79             # optional, if not set the system hostname will be used
80             hostname=>'somehost'
81            
82             # ignored when filename is set
83             basefilename=>'myapp',
84             folder=>'/var/myappfolder',
85            
86             );
87            
88             When the constructor is called with a single argument it is assumed to be the fully quallified name of the log file to manage and rotate.
89            
90             my $log=new Net::SolarWinds::Log('/some/log/file.log');
91            
92             =cut
93            
94             sub new {
95 6     6 0 4529 my ( $class, @args ) = @_;
96            
97 6 100       36 unshift @args, 'filename' if ( $#args == 0 );
98            
99 6         63 my $self = $class->SUPER::new(
100             loglevel => $class->DEFAULT_LOG_LEVEL,
101             basefilename => 'changeme',
102             hostname => hostname,
103             @args
104             );
105             }
106            
107             =item * my $hash=$self->lookback(stack_level);
108            
109             This method returns a hash that provides information about who called this function relative to the stack_level argument. The class default value is 4.
110            
111             Example result
112            
113             {
114             # the fully qualified package that this method ran under
115             package=>'main',
116            
117             # the package and subrouteen this was called under
118             sub=>'main::some_method',
119            
120             # the source file ( may be eval or undef )
121             filename=>'/path/to/my/Script',
122            
123             # the line in wich the function was called
124             # if the internals are unsure the value is undef
125             line=>11
126             }
127            
128             =cut
129            
130             sub lookback {
131 60     60 1 158 my ( $self, $level ) = @_;
132            
133 60         164 my $hash = {};
134 60         477 @{$hash}{qw(package filename line sub)} = caller($level);
  60         331  
135            
136             # Look up the stack until we find something that explains who and what called us
137 60   100     555 LOOK_BACK_LOOP: while ( defined( $hash->{sub} ) and $hash->{sub} =~ /eval/ ) {
138            
139 5         47 my $copy = {%$hash};
140 5         40 @{$hash}{qw(package filename line sub)} = caller( ++$level );
  5         23  
141            
142             # give up when we have a dead package name
143 5 100       50 unless ( defined( $hash->{package} ) ) {
144            
145 1         4 $hash = $copy;
146 1         4 $hash->{eval} = 1;
147            
148 1         3 last LOOK_BACK_LOOP;
149            
150             }
151            
152             }
153            
154             # if we don't know where we were called from, we can assume main.
155 1         5 @{$hash}{qw(sub filename package line)} = ( 'main::', $0, 'main', 'undef' )
156 60 100       217 unless defined( $hash->{package} );
157            
158 60         178 return $hash;
159             }
160            
161             =item * my $string=$log->format_log('LEVEL=ERROR|WARN|INFO|DEBUG',"some log");
162            
163             Formats your log entry as:
164            
165             HOSTNAME PID TIMESTAMP LEVEL STACK_TRACE DATA \n
166            
167             Special notes: any undef value will be converted to a string value of 'undef'.
168            
169             =cut
170            
171             sub format_log {
172 59     59 1 180 my ( $self, $level, @info ) = @_;
173            
174 59         163 foreach my $string (@info) {
175            
176 59 50       209 unless ( defined($string) ) {
177 0         0 $string = 'undef';
178             }
179            
180             }
181            
182 59         249 my $lb = $self->lookback( $self->LOOK_BACK_DEPTH );
183            
184 59         8222 my $string = join ' ', $self->{hostname}, $$, scalar(localtime), $level, $lb->{sub}, @info;
185 59         420 return $string . "\n";
186             }
187            
188             =item * $log->log_info("message");
189            
190             Logs to a file if the log level is LOG_INFO or greater.
191            
192             =cut
193            
194             sub log_info {
195 5     5 1 3376 my ( $self, @args ) = @_;
196            
197 5 100       33 return unless $self->{loglevel} >= $self->LOG_INFO;
198            
199 2         9 $self->write_to_log( 'INFO', @args );
200             }
201            
202             =item * $log->log_error("message");
203            
204             Logs to a file if the log level is LOG_error or greater.
205            
206             =cut
207            
208             sub log_error {
209 10     10 1 4162 my ( $self, @args ) = @_;
210            
211 10 100       63 return unless $self->{loglevel} >= $self->LOG_ERROR;
212            
213 8         29 $self->write_to_log( 'ERROR', @args );
214             }
215            
216             =item * $log->log_die("Some message");
217            
218             Logs the message then dies.
219            
220             =cut
221            
222             sub log_die {
223 1     1 1 17 my ($self,@args)=@_;
224 1         5 my $string=$self->format_log('DIE',@args);
225            
226 1 50       11 die $string unless $self->{loglevel} >= $self->LOG_ALWAYS;
227            
228 1         6 $self->write_to_log( 'DIE', @args );
229 1         9 die $string;
230             }
231            
232             =item * $log->log_warn("message");
233            
234             Logs to a file if the log level is LOG_WARN or greater.
235            
236             =cut
237            
238             sub log_warn {
239 5     5 1 3898 my ( $self, @args ) = @_;
240            
241 5 100       53 return unless $self->{loglevel} >= $self->LOG_WARN;
242            
243 3         23 $self->write_to_log( 'WARN', @args );
244             }
245            
246             =item * $log->log_always("message");
247            
248             Logs to a file if the log level is LOG_ALWAYS or greater.
249            
250             =cut
251            
252             sub log_always {
253 5     5 1 3041 my ( $self, @args ) = @_;
254            
255 5 50       30 return unless $self->{loglevel} >= $self->LOG_ALWAYS;
256            
257 5         17 $self->write_to_log( 'ALWAYS', @args );
258             }
259            
260             =item * $log->log_debug("message");
261            
262             Logs to a file if the log level is LOG_DEBUG or greater.
263            
264             =cut
265            
266             sub log_debug {
267 5     5 1 3409 my ( $self, @args ) = @_;
268            
269 5 100       31 return unless $self->{loglevel} >= $self->LOG_DEBUG;
270            
271 1         5 $self->write_to_log( 'DEBUG', @args );
272             }
273            
274             =item * $log->write_to_log('LEVEL=ERROR|WARN|INFO|DEBUG','message');
275            
276             Writes 'message' to the log file with formatting representing 2 levels aboive itself in the stack.
277            
278             =cut
279            
280             sub write_to_log {
281 57     57 1 196 my ( $self, @info ) = @_;
282            
283 57         183 my $string = $self->format_log(@info);
284            
285 57         307 $self->write_to_file($string);
286             }
287            
288             =item * my $loglevel=$log->get_loglevel;
289            
290             Returns the current runtime loglevel.
291            
292             =cut
293            
294             sub get_loglevel {
295 59     59 1 432 $_[0]->{loglevel};
296             }
297            
298             =item * $log->set_loglevel(level);
299            
300             Used to set the current loglevel to the level.
301            
302             =cut
303            
304             sub set_loglevel {
305 17     17 1 15616 my ( $self, $level ) = @_;
306 17         68 $self->{loglevel} = $level;
307             }
308            
309             # overload default functions, but make them work.. sort of
310 1     1 1 1325 sub get_log { $_[0] }
311 0     0 0   sub set_log { croak "Cannot set log object within itself!" }
312            
313             =back
314            
315             =head1 Author
316            
317             Michael Shipper
318            
319             =cut
320            
321             1;