Commit | Line | Data |
ae59bbe3 |
1 | package Log::Contextual::WarnLogger; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
e7b18282 |
6 | use Carp 'croak'; |
7 | |
8 | my @default_levels = qw( trace debug info warn error fatal ); |
9 | |
10 | |
11 | # generate subs to handle the default levels |
12 | # anything else will have to be handled by AUTOLOAD at runtime |
ae59bbe3 |
13 | { |
e7b18282 |
14 | for my $level (@default_levels) { |
ae59bbe3 |
15 | |
16 | no strict 'refs'; |
17 | |
e7b18282 |
18 | my $is_name = "is_$level"; |
19 | *{$level} = sub { |
ae59bbe3 |
20 | my $self = shift; |
21 | |
e7b18282 |
22 | $self->_log( $level, @_ ) |
ae59bbe3 |
23 | if $self->$is_name; |
24 | }; |
25 | |
26 | *{$is_name} = sub { |
27 | my $self = shift; |
e7b18282 |
28 | return 1 if $ENV{$self->{env_prefix} . '_' . uc $level}; |
6d77ba42 |
29 | my $upto = $ENV{$self->{env_prefix} . '_UPTO'}; |
30 | return unless $upto; |
31 | $upto = lc $upto; |
32 | |
e7b18282 |
33 | return $self->{level_num}{$level} >= $self->{level_num}{$upto}; |
ae59bbe3 |
34 | }; |
35 | } |
36 | } |
37 | |
e7b18282 |
38 | our $AUTOLOAD; |
39 | sub AUTOLOAD { |
40 | my $self = $_[0]; |
41 | |
42 | (my $name = our $AUTOLOAD) =~ s/.*:://; |
43 | return if $name eq 'DESTROY'; |
44 | |
45 | # extract the log level from the sub name |
46 | my ($is, $level) = $name =~ m/^(is_)?(.+)$/; |
47 | my $is_name = "is_$level"; |
48 | |
49 | no strict 'refs'; |
50 | *{$level} = sub { |
51 | my $self = shift; |
52 | |
53 | $self->_log( $level, @_ ) |
54 | if $self->$is_name; |
55 | }; |
56 | |
57 | *{$is_name} = sub { |
58 | my $self = shift; |
59 | |
60 | my $prefix_field = $self->{env_prefix} . '_' . uc $level; |
61 | return 1 if $ENV{$prefix_field}; |
62 | |
63 | # don't log if the variable specifically says not to |
64 | return 0 if defined $ENV{$prefix_field} and not $ENV{$prefix_field}; |
65 | |
66 | my $upto_field = $self->{env_prefix} . '_UPTO'; |
67 | my $upto = $ENV{$upto_field}; |
68 | |
69 | if ($upto) { |
70 | $upto = lc $upto; |
71 | |
72 | croak "Unrecognized log level '$upto' in \$ENV{$upto_field}" |
73 | if not defined $self->{level_num}{$upto}; |
74 | |
75 | return $self->{level_num}{$level} >= $self->{level_num}{$upto}; |
76 | } |
77 | |
78 | # if we don't recognize this level and nothing says otherwise, log! |
79 | return 1 if not $self->{custom_levels}; |
80 | }; |
81 | goto &$AUTOLOAD; |
82 | } |
83 | |
ae59bbe3 |
84 | sub new { |
85 | my ($class, $args) = @_; |
e7b18282 |
86 | |
87 | my $levels = $args->{levels}; |
88 | croak 'invalid levels specification: must be non-empty arrayref' |
89 | if defined $levels and (ref $levels ne 'ARRAY' or !@$levels); |
90 | |
91 | my $custom_levels = defined $levels; |
92 | $levels ||= [ @default_levels ]; |
93 | |
94 | my %level_num; @level_num{ @$levels } = (0 .. $#{$levels}); |
95 | |
96 | my $self = bless { |
97 | levels => $levels, |
98 | level_num => \%level_num, |
99 | custom_levels => $custom_levels, |
100 | }, $class; |
ae59bbe3 |
101 | |
102 | $self->{env_prefix} = $args->{env_prefix} or |
103 | die 'no env_prefix passed to Log::Contextual::WarnLogger->new'; |
104 | return $self; |
105 | } |
106 | |
107 | sub _log { |
108 | my $self = shift; |
109 | my $level = shift; |
110 | my $message = join( "\n", @_ ); |
111 | $message .= "\n" unless $message =~ /\n$/; |
112 | warn "[$level] $message"; |
113 | } |
114 | |
115 | 1; |
116 | |
117 | __END__ |
118 | |
119 | =head1 NAME |
120 | |
121 | Log::Contextual::WarnLogger - Simple logger for libraries using Log::Contextual |
122 | |
123 | =head1 SYNOPSIS |
124 | |
125 | package My::Package; |
126 | use Log::Contextual::WarnLogger; |
127 | use Log::Contextual qw( :log ), |
128 | -default_logger => Log::Contextual::WarnLogger->new({ |
e7b18282 |
129 | env_prefix => 'MY_PACKAGE', |
130 | levels => [ qw(debug info notice warning error critical alert emergency) ], |
ae59bbe3 |
131 | }); |
132 | |
133 | # warns '[info] program started' if $ENV{MY_PACKAGE_TRACE} is set |
134 | log_info { 'program started' }; # no-op because info is not in levels |
135 | sub foo { |
136 | # warns '[debug] entered foo' if $ENV{MY_PACKAGE_DEBUG} is set |
137 | log_debug { 'entered foo' }; |
138 | ... |
139 | } |
140 | |
e7b18282 |
141 | |
142 | |
ae59bbe3 |
143 | =head1 DESCRIPTION |
144 | |
145 | This module is a simple logger made for libraries using L<Log::Contextual>. We |
146 | recommend the use of this logger as your default logger as it is simple and |
147 | useful for most users, yet users can use L<Log::Contextual/set_logger> to override |
148 | your choice of logger in their own code thanks to the way L<Log::Contextual> |
149 | works. |
150 | |
151 | =head1 METHODS |
152 | |
153 | =head2 new |
154 | |
e7b18282 |
155 | Arguments: C<< Dict[ env_prefix => Str, levels => List ] $conf >> |
ae59bbe3 |
156 | |
157 | my $l = Log::Contextual::WarnLogger->new({ |
e7b18282 |
158 | env_prefix => 'BAR' |
159 | }); |
160 | |
161 | or: |
162 | |
163 | my $l = Log::Contextual::WarnLogger->new({ |
164 | env_prefix => 'BAR', |
165 | levels => [ 'level1', 'level2' ] |
166 | |
ae59bbe3 |
167 | }); |
168 | |
169 | Creates a new logger object where C<env_prefix> defines what the prefix is for |
e7b18282 |
170 | the environment variables that will be checked for the log levels. |
171 | |
172 | The log levels may be customized, but if not defined, these are used: |
173 | |
174 | =over 4 |
175 | |
176 | =item trace |
177 | |
178 | =item debug |
179 | |
180 | =item info |
181 | |
182 | =item warn |
183 | |
184 | =item error |
185 | |
186 | =item fatal |
187 | |
188 | =back |
189 | |
190 | For example, if C<env_prefix> is set to C<FREWS_PACKAGE> the following environment |
ae59bbe3 |
191 | variables will be used: |
192 | |
6d77ba42 |
193 | FREWS_PACKAGE_UPTO |
194 | |
ae59bbe3 |
195 | FREWS_PACKAGE_TRACE |
196 | FREWS_PACKAGE_DEBUG |
197 | FREWS_PACKAGE_INFO |
198 | FREWS_PACKAGE_WARN |
199 | FREWS_PACKAGE_ERROR |
200 | FREWS_PACKAGE_FATAL |
201 | |
6d77ba42 |
202 | Note that C<UPTO> is a convenience variable. If you set |
203 | C<< FOO_UPTO=TRACE >> it will enable all log levels. Similarly, if you |
204 | set it to C<FATAL> only fatal will be enabled. |
205 | |
e7b18282 |
206 | =back |
207 | |
ae59bbe3 |
208 | =head2 $level |
209 | |
210 | Arguments: C<@anything> |
211 | |
212 | All of the following six methods work the same. The basic pattern is: |
213 | |
214 | sub $level { |
215 | my $self = shift; |
216 | |
217 | warn "[$level] " . join qq{\n}, @_; |
218 | if $self->is_$level; |
219 | } |
220 | |
221 | =head3 trace |
222 | |
223 | $l->trace( 'entered method foo with args ' join q{,}, @args ); |
224 | |
225 | =head3 debug |
226 | |
227 | $l->debug( 'entered method foo' ); |
228 | |
229 | =head3 info |
230 | |
231 | $l->info( 'started process foo' ); |
232 | |
233 | =head3 warn |
234 | |
235 | $l->warn( 'possible misconfiguration at line 10' ); |
236 | |
237 | =head3 error |
238 | |
239 | $l->error( 'non-numeric user input!' ); |
240 | |
241 | =head3 fatal |
242 | |
243 | $l->fatal( '1 is never equal to 0!' ); |
244 | |
e7b18282 |
245 | If different levels are specified, appropriate functions named for your custom |
246 | levels work as you expect. |
247 | |
ae59bbe3 |
248 | =head2 is_$level |
249 | |
250 | All of the following six functions just return true if their respective |
251 | environment variable is enabled. |
252 | |
253 | =head3 is_trace |
254 | |
255 | say 'tracing' if $l->is_trace; |
256 | |
257 | =head3 is_debug |
258 | |
259 | say 'debuging' if $l->is_debug; |
260 | |
261 | =head3 is_info |
262 | |
263 | say q{info'ing} if $l->is_info; |
264 | |
265 | =head3 is_warn |
266 | |
267 | say 'warning' if $l->is_warn; |
268 | |
269 | =head3 is_error |
270 | |
271 | say 'erroring' if $l->is_error; |
272 | |
273 | =head3 is_fatal |
274 | |
275 | say q{fatal'ing} if $l->is_fatal; |
276 | |
e7b18282 |
277 | If different levels are specified, appropriate is_$level functions work as you |
278 | would expect. |
279 | |
ae59bbe3 |
280 | =head1 AUTHOR |
281 | |
282 | See L<Log::Contextual/"AUTHOR"> |
283 | |
284 | =head1 COPYRIGHT |
285 | |
286 | See L<Log::Contextual/"COPYRIGHT"> |
287 | |
288 | =head1 LICENSE |
289 | |
290 | See L<Log::Contextual/"LICENSE"> |
291 | |
292 | =cut |
293 | |