File Coverage

blib/lib/Log/Handler/Levels.pm
Criterion Covered Total %
statement 45 72 62.5
branch 14 44 31.8
condition 4 6 66.6
subroutine 10 13 76.9
pod 4 4 100.0
total 77 139 55.4


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Log::Handler::Levels - All levels for Log::Handler.
4              
5             =head1 DESCRIPTION
6              
7             Base class for Log::Handler.
8              
9             Just for internal usage and documentation.
10              
11             =head1 METHODS
12              
13             =head2 Default log level
14              
15             =over
16              
17             =item B
18              
19             =item B
20              
21             =item B
22              
23             =item B, B
24              
25             =item B, B
26              
27             =item B, B
28              
29             =item B
30              
31             =item B, B
32              
33             =back
34              
35             =head2 Checking for active levels
36              
37             =over
38              
39             =item B
40              
41             =item B
42              
43             =item B
44              
45             =item B, B
46              
47             =item B, B
48              
49             =item B, B
50              
51             =item B
52              
53             =item B, B
54              
55             =back
56              
57             =head2 Special level
58              
59             =over
60              
61             =item B
62              
63             Alternative for the levels C - C.
64              
65             =item B
66              
67             Check if one of the levels C - C is active.
68              
69             =back
70              
71             =head2 Special methods
72              
73             =over
74              
75             =item B
76              
77             This method is very useful if you want to add a full backtrace to
78             your message. Maybe you want to intercept unexpected errors and
79             want to know who called C.
80              
81             $SIG{__DIE__} = sub { $log->trace(emergency => @_) };
82              
83             By default the backtrace is logged as level C.
84              
85             # would log with the level debug
86             $log->trace('who called who');
87              
88             If you want to log with another level then you can pass the level
89             as first argument:
90              
91             $log->trace(info => $message);
92              
93             =item B
94              
95             If you want to dump something then you can use C.
96             The default level is C.
97              
98             my %hash = (foo => 1, bar => 2);
99              
100             $log->dump(\%hash);
101              
102             If you want to log with another level then you can pass the level
103             as first argument:
104              
105             $log->dump($level => \%hash);
106              
107             =item B
108              
109             This method logs the message to the output and then call C
110             with the level C by default.
111              
112             $log->die('an emergency error here');
113              
114             If you want to log with another level, then you can pass the level
115             as first argument:
116              
117             $log->die(fatal => 'an emergency error here');
118              
119             =item B
120              
121             With this method it's possible to log messages with the log level as
122             first argument:
123              
124             $log->log(info => 'an info message');
125              
126             Is the same like
127              
128             $log->info('an info message');
129              
130             and
131              
132             $log->log('an info message');
133              
134             If you log without a level then the default level is C.
135              
136             =back
137              
138             =head1 PREREQUISITES
139              
140             Carp
141             Data::Dumper
142              
143             =head1 EXPORTS
144              
145             No exports.
146              
147             =head1 REPORT BUGS
148              
149             Please report all bugs to .
150              
151             If you send me a mail then add Log::Handler into the subject.
152              
153             =head1 AUTHOR
154              
155             Jonny Schulz .
156              
157             =head1 COPYRIGHT
158              
159             Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.
160              
161             This program is free software; you can redistribute it and/or
162             modify it under the same terms as Perl itself.
163              
164             =cut
165              
166             package Log::Handler::Levels;
167              
168 15     15   131 use strict;
  15         34  
  15         434  
169 15     15   75 use warnings;
  15         29  
  15         375  
170 15     15   73 use Carp;
  15         38  
  15         744  
171 15     15   9623 use Data::Dumper;
  15         104606  
  15         1890  
172              
173             our $VERSION = '0.07';
174              
175             my %LEVELS_BY_ROUTINE = (
176             debug => 'DEBUG',
177             info => 'INFO',
178             notice => 'NOTICE',
179             warning => 'WARNING',
180             warn => 'WARNING',
181             error => 'ERROR',
182             err => 'ERROR',
183             critical => 'CRITICAL',
184             crit => 'CRITICAL',
185             alert => 'ALERT',
186             emergency => 'EMERGENCY',
187             emerg => 'EMERGENCY',
188             fatal => 'FATAL',
189             );
190              
191             foreach my $routine (keys %LEVELS_BY_ROUTINE) {
192             my $level = $LEVELS_BY_ROUTINE{$routine};
193              
194             { # start "no strict 'refs'" block
195 15     15   122 no strict 'refs';
  15         35  
  15         711  
196              
197             # --------------------------------------------------------------
198             # Creating the syslog level methods
199             # --------------------------------------------------------------
200              
201             *{"$routine"} = sub {
202 15     15   87 use strict 'refs';
  15         31  
  15         3842  
203 52     52   3107 my $self = shift;
204 52         104 my $levels = $self->{levels};
205 52         96 my ($errors, $caller);
206              
207 52 100       169 if ( !$levels->{$level} ) {
208 4         11 return 1;
209             }
210              
211 48         88 foreach my $output ( @{$levels->{$level}} ) {
  48         135  
212 80 100 66     489 if ($output->{category} || $output->{filter_caller} || $output->{except_caller}) {
      66        
213 2 50       13 if (!$caller) {
214 2         18 $caller = (caller($Log::Handler::CALLER_LEVEL))[0];
215             }
216              
217 2 50       11 if ($output->{category}) {
    50          
    0          
218 0         0 my $category = $output->{category};
219 0 0       0 return 1 if $caller !~ $output->{category};
220             } elsif ($output->{filter_caller}) {
221 2 100       23 return 1 if $caller !~ $output->{filter_caller};
222             } elsif ($output->{except_caller}) {
223 0 0       0 return 1 if $caller =~ $output->{except_caller};
224             }
225             }
226              
227 79 50       251 if ( !$output->log($level, @_) ) {
228 0 0       0 if ( defined $errors ) {
229 0         0 $errors .= '; ' . $output->errstr;
230             } else {
231 0         0 $errors = $output->errstr;
232             }
233             }
234             }
235              
236 47 50       184 return defined $errors ? $self->_raise_error($errors) : 1;
237             };
238              
239             # --------------------------------------------------------------
240             # Creating the is_ methods
241             # --------------------------------------------------------------
242              
243             *{"is_$routine"} = sub {
244 15     15   123 use strict 'refs';
  15         30  
  15         6659  
245 25     25   1361 my $self = shift;
246 25         48 my $levels = $self->{levels};
247 25 50       139 return $levels->{$level} ? 1 : 0;
248             };
249              
250             } # end "no strict 'refs'" block
251             }
252              
253             sub log {
254 0     0 1 0 my $self = shift;
255 0 0       0 my $level = @_ > 1 ? lc(shift) : 'info';
256 0 0       0 if (!exists $LEVELS_BY_ROUTINE{$level}) {
257 0         0 $level = 'info';
258             }
259 0         0 local $Log::Handler::CALLER_LEVEL = 1;
260 0         0 return $self->$level(@_);
261             }
262              
263             sub trace {
264 0     0 1 0 my $self = shift;
265 0 0       0 my $level = @_ > 1 ? lc(shift) : 'debug';
266 0 0       0 if (!exists $LEVELS_BY_ROUTINE{$level}) {
267 0         0 $level = 'debug';
268             }
269 0         0 local $Log::Handler::CALLER_LEVEL = 1;
270 0         0 local $Log::Handler::TRACE = 1;
271 0         0 return $self->$level(@_);
272             }
273              
274             sub die {
275 13     13 1 4300 my $self = shift;
276 13 50       42 my $level = @_ > 1 ? lc(shift) : 'emergency';
277 13 50       36 if (!exists $LEVELS_BY_ROUTINE{$level}) {
278 0         0 $level = 'emergency';
279             }
280 13         24 local $Log::Handler::CALLER_LEVEL = 1;
281 13         38 my @caller = caller;
282 13         109 $self->$level(@_, "at line $caller[2]");
283 13         1029 Carp::croak @_;
284             };
285              
286             sub dump {
287 0     0 1   my $self = shift;
288 0 0         my $level = @_ > 1 ? lc(shift) : 'debug';
289 0           my $is_level = "is_$level";
290 0 0         if (!exists $LEVELS_BY_ROUTINE{$level}) {
291 0           $level = 'debug';
292             }
293 0           local $Log::Handler::CALLER_LEVEL = 1;
294 0 0         return $self->$is_level ? $self->$level(Dumper(@_)) : 1;
295             }
296              
297             1;