Commit | Line | Data |
ae59bbe3 |
1 | package Log::Contextual::WarnLogger; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | { |
6d77ba42 |
7 | my @levels = (qw( trace debug info warn error fatal )); |
8 | my %level_num; @level_num{ @levels } = (0 .. $#levels); |
9 | for my $name (@levels) { |
ae59bbe3 |
10 | |
11 | no strict 'refs'; |
12 | |
13 | my $is_name = "is_$name"; |
14 | *{$name} = sub { |
15 | my $self = shift; |
16 | |
17 | $self->_log( $name, @_ ) |
18 | if $self->$is_name; |
19 | }; |
20 | |
21 | *{$is_name} = sub { |
22 | my $self = shift; |
6d77ba42 |
23 | return 1 if $ENV{$self->{env_prefix} . '_' . uc $name}; |
24 | my $upto = $ENV{$self->{env_prefix} . '_UPTO'}; |
25 | return unless $upto; |
26 | $upto = lc $upto; |
27 | |
28 | return $level_num{$name} >= $level_num{$upto}; |
ae59bbe3 |
29 | }; |
30 | } |
31 | } |
32 | |
33 | sub new { |
34 | my ($class, $args) = @_; |
35 | my $self = bless {}, $class; |
36 | |
37 | $self->{env_prefix} = $args->{env_prefix} or |
38 | die 'no env_prefix passed to Log::Contextual::WarnLogger->new'; |
39 | return $self; |
40 | } |
41 | |
42 | sub _log { |
43 | my $self = shift; |
44 | my $level = shift; |
45 | my $message = join( "\n", @_ ); |
46 | $message .= "\n" unless $message =~ /\n$/; |
47 | warn "[$level] $message"; |
48 | } |
49 | |
50 | 1; |
51 | |
52 | __END__ |
53 | |
54 | =head1 NAME |
55 | |
56 | Log::Contextual::WarnLogger - Simple logger for libraries using Log::Contextual |
57 | |
58 | =head1 SYNOPSIS |
59 | |
60 | package My::Package; |
61 | use Log::Contextual::WarnLogger; |
62 | use Log::Contextual qw( :log ), |
63 | -default_logger => Log::Contextual::WarnLogger->new({ |
64 | env_prefix => 'MY_PACKAGE' |
65 | }); |
66 | |
67 | # warns '[info] program started' if $ENV{MY_PACKAGE_TRACE} is set |
68 | log_info { 'program started' }; # no-op because info is not in levels |
69 | sub foo { |
70 | # warns '[debug] entered foo' if $ENV{MY_PACKAGE_DEBUG} is set |
71 | log_debug { 'entered foo' }; |
72 | ... |
73 | } |
74 | |
75 | =head1 DESCRIPTION |
76 | |
77 | This module is a simple logger made for libraries using L<Log::Contextual>. We |
78 | recommend the use of this logger as your default logger as it is simple and |
79 | useful for most users, yet users can use L<Log::Contextual/set_logger> to override |
80 | your choice of logger in their own code thanks to the way L<Log::Contextual> |
81 | works. |
82 | |
83 | =head1 METHODS |
84 | |
85 | =head2 new |
86 | |
87 | Arguments: C<< Dict[ env_prefix => Str ] $conf >> |
88 | |
89 | my $l = Log::Contextual::WarnLogger->new({ |
90 | env_prefix |
91 | }); |
92 | |
93 | Creates a new logger object where C<env_prefix> defines what the prefix is for |
94 | the environment variables that will be checked for the six log levels. For |
95 | example, if C<env_prefix> is set to C<FREWS_PACKAGE> the following environment |
96 | variables will be used: |
97 | |
6d77ba42 |
98 | FREWS_PACKAGE_UPTO |
99 | |
ae59bbe3 |
100 | FREWS_PACKAGE_TRACE |
101 | FREWS_PACKAGE_DEBUG |
102 | FREWS_PACKAGE_INFO |
103 | FREWS_PACKAGE_WARN |
104 | FREWS_PACKAGE_ERROR |
105 | FREWS_PACKAGE_FATAL |
106 | |
6d77ba42 |
107 | Note that C<UPTO> is a convenience variable. If you set |
108 | C<< FOO_UPTO=TRACE >> it will enable all log levels. Similarly, if you |
109 | set it to C<FATAL> only fatal will be enabled. |
110 | |
ae59bbe3 |
111 | =head2 $level |
112 | |
113 | Arguments: C<@anything> |
114 | |
115 | All of the following six methods work the same. The basic pattern is: |
116 | |
117 | sub $level { |
118 | my $self = shift; |
119 | |
120 | warn "[$level] " . join qq{\n}, @_; |
121 | if $self->is_$level; |
122 | } |
123 | |
124 | =head3 trace |
125 | |
126 | $l->trace( 'entered method foo with args ' join q{,}, @args ); |
127 | |
128 | =head3 debug |
129 | |
130 | $l->debug( 'entered method foo' ); |
131 | |
132 | =head3 info |
133 | |
134 | $l->info( 'started process foo' ); |
135 | |
136 | =head3 warn |
137 | |
138 | $l->warn( 'possible misconfiguration at line 10' ); |
139 | |
140 | =head3 error |
141 | |
142 | $l->error( 'non-numeric user input!' ); |
143 | |
144 | =head3 fatal |
145 | |
146 | $l->fatal( '1 is never equal to 0!' ); |
147 | |
148 | =head2 is_$level |
149 | |
150 | All of the following six functions just return true if their respective |
151 | environment variable is enabled. |
152 | |
153 | =head3 is_trace |
154 | |
155 | say 'tracing' if $l->is_trace; |
156 | |
157 | =head3 is_debug |
158 | |
159 | say 'debuging' if $l->is_debug; |
160 | |
161 | =head3 is_info |
162 | |
163 | say q{info'ing} if $l->is_info; |
164 | |
165 | =head3 is_warn |
166 | |
167 | say 'warning' if $l->is_warn; |
168 | |
169 | =head3 is_error |
170 | |
171 | say 'erroring' if $l->is_error; |
172 | |
173 | =head3 is_fatal |
174 | |
175 | say q{fatal'ing} if $l->is_fatal; |
176 | |
177 | =head1 AUTHOR |
178 | |
179 | See L<Log::Contextual/"AUTHOR"> |
180 | |
181 | =head1 COPYRIGHT |
182 | |
183 | See L<Log::Contextual/"COPYRIGHT"> |
184 | |
185 | =head1 LICENSE |
186 | |
187 | See L<Log::Contextual/"LICENSE"> |
188 | |
189 | =cut |
190 | |