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   10923 use strict;
  4         8  
  4         100  
32 4     4   19 use warnings;
  4         8  
  4         117  
33 4     4   19 use base qw(Net::SolarWinds::FileRotationBase);
  4         6  
  4         1678  
34 4     4   27 use File::Basename qw(basename);
  4         8  
  4         257  
35 4     4   22 use Scalar::Util qw(looks_like_number);
  4         9  
  4         216  
36 4     4   1550 use Sys::Hostname;
  4         3162  
  4         181  
37 4     4   27 use Carp qw(croak);
  4         11  
  4         245  
38             require Exporter;
39            
40             our @EXPORT_OK = (qw(LOG_NONE LOG_ERROR LOG_WARN LOG_INFO LOG_DEBUG));
41            
42 4     4   22 use constant LOOK_BACK_DEPTH => 4;
  4         9  
  4         361  
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   24 use constant LOG_NONE => -1;
  4         8  
  4         156  
53 4     4   20 use constant LOG_ALWAYS => 0;
  4         8  
  4         142  
54 4     4   27 use constant LOG_ERROR => 1;
  4         7  
  4         141  
55 4     4   20 use constant LOG_WARN => 2;
  4         8  
  4         153  
56 4     4   21 use constant LOG_INFO => 3;
  4         7  
  4         155  
57 4     4   28 use constant LOG_DEBUG => 4;
  4         6  
  4         153  
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   18 use constant DEFAULT_LOG_LEVEL => 1;
  4         9  
  4         2452  
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 3936 my ( $class, @args ) = @_;
96            
97 6 100       27 unshift @args, 'filename' if ( $#args == 0 );
98            
99 6         39 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 110 my ( $self, $level ) = @_;
132            
133 60         119 my $hash = {};
134 60         320 @{$hash}{qw(package filename line sub)} = caller($level);
  60         237  
135            
136             # Look up the stack until we find something that explains who and what called us
137 60   100     399 LOOK_BACK_LOOP: while ( defined( $hash->{sub} ) and $hash->{sub} =~ /eval/ ) {
138            
139 5         26 my $copy = {%$hash};
140 5         23 @{$hash}{qw(package filename line sub)} = caller( ++$level );
  5         14  
141            
142             # give up when we have a dead package name
143 5 100       32 unless ( defined( $hash->{package} ) ) {
144            
145 1         2 $hash = $copy;
146 1         3 $hash->{eval} = 1;
147            
148 1         2 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         4 @{$hash}{qw(sub filename package line)} = ( 'main::', $0, 'main', 'undef' )
156 60 100       146 unless defined( $hash->{package} );
157            
158 60         123 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 125 my ( $self, $level, @info ) = @_;
173            
174 59         139 foreach my $string (@info) {
175            
176 59 50       145 unless ( defined($string) ) {
177 0         0 $string = 'undef';
178             }
179            
180             }
181            
182 59         188 my $lb = $self->lookback( $self->LOOK_BACK_DEPTH );
183            
184 59         2139 my $string = join ' ', $self->{hostname}, $$, scalar(localtime), $level, $lb->{sub}, @info;
185 59         269 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 2686 my ( $self, @args ) = @_;
196            
197 5 100       23 return unless $self->{loglevel} >= $self->LOG_INFO;
198            
199 2         6 $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 2671 my ( $self, @args ) = @_;
210            
211 10 100       48 return unless $self->{loglevel} >= $self->LOG_ERROR;
212            
213 8         18 $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 14 my ($self,@args)=@_;
224 1         5 my $string=$self->format_log('DIE',@args);
225            
226 1 50       9 die $string unless $self->{loglevel} >= $self->LOG_ALWAYS;
227            
228 1         6 $self->write_to_log( 'DIE', @args );
229 1         8 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 2889 my ( $self, @args ) = @_;
240            
241 5 100       37 return unless $self->{loglevel} >= $self->LOG_WARN;
242            
243 3         20 $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 2208 my ( $self, @args ) = @_;
254            
255 5 50       21 return unless $self->{loglevel} >= $self->LOG_ALWAYS;
256            
257 5         12 $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 2334 my ( $self, @args ) = @_;
268            
269 5 100       22 return unless $self->{loglevel} >= $self->LOG_DEBUG;
270            
271 1         3 $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 134 my ( $self, @info ) = @_;
282            
283 57         120 my $string = $self->format_log(@info);
284            
285 57         211 $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 287 $_[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 10994 my ( $self, $level ) = @_;
306 17         47 $self->{loglevel} = $level;
307             }
308            
309             # overload default functions, but make them work.. sort of
310 1     1 1 1477 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;