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