Commit | Line | Data |
f0ac4cdb |
1 | package Log::Message::Simple; |
2 | |
3 | use strict; |
4 | use Log::Message private => 0;; |
5 | |
6 | BEGIN { |
7 | use vars qw[$VERSION]; |
8 | $VERSION = 0.01; |
9 | } |
10 | |
11 | |
12 | =pod |
13 | |
14 | =head1 NAME |
15 | |
16 | Log::Message::Simple |
17 | |
18 | =head1 SYNOPSIS |
19 | |
20 | use Log::Message::Simple qw[msg error debug |
21 | carp croak cluck confess]; |
22 | |
23 | use Log::Message::Simple qw[:STD :CARP]; |
24 | |
25 | ### standard reporting functionality |
26 | msg( "Connecting to database", $verbose ); |
27 | error( "Database connection failed: $@", $verbose ); |
28 | debug( "Connection arguments were: $args", $debug ); |
29 | |
30 | ### standard carp functionality |
31 | carp( "Wrong arguments passed: @_" ); |
32 | croak( "Fatal: wrong arguments passed: @_" ); |
33 | cluck( "Wrong arguments passed -- including stacktrace: @_" ); |
34 | confess("Fatal: wrong arguments passed -- including stacktrace: @_" ); |
35 | |
36 | ### retrieve individual message |
37 | my @stack = Log::Message::Simple->stack; |
38 | my @stack = Log::Message::Simple->flush; |
39 | |
40 | ### retrieve the entire stack in printable form |
41 | my $msgs = Log::Message::Simple->stack_as_string; |
42 | my $trace = Log::Message::Simple->stack_as_string(1); |
43 | |
44 | ### redirect output |
45 | local $Log::Message::Simple::MSG_FH = \*STDERR; |
46 | local $Log::Message::Simple::ERROR_FH = \*STDERR; |
47 | local $Log::Message::Simple::DEBUG_FH = \*STDERR; |
48 | |
49 | ### force a stacktrace on error |
50 | local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1 |
51 | |
52 | =head1 DESCRIPTION |
53 | |
54 | This module provides standardized logging facilities using the |
55 | C<Log::Message> module. |
56 | |
57 | =head1 FUNCTIONS |
58 | |
59 | =head2 msg("message string" [,VERBOSE]) |
60 | |
61 | Records a message on the stack, and prints it to C<STDOUT> (or actually |
62 | C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the |
63 | C<VERBOSE> option is true. |
64 | The C<VERBOSE> option defaults to false. |
65 | |
66 | Exported by default, or using the C<:STD> tag. |
67 | |
68 | =head2 debug("message string" [,VERBOSE]) |
69 | |
70 | Records a debug message on the stack, and prints it to C<STDOUT> (or |
71 | actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below), |
72 | if the C<VERBOSE> option is true. |
73 | The C<VERBOSE> option defaults to false. |
74 | |
75 | Exported by default, or using the C<:STD> tag. |
76 | |
77 | =head2 error("error string" [,VERBOSE]) |
78 | |
79 | Records an error on the stack, and prints it to C<STDERR> (or actually |
80 | C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the |
81 | C<VERBOSE> option is true. |
82 | The C<VERBOSE> options defaults to true. |
83 | |
84 | Exported by default, or using the C<:STD> tag. |
85 | |
86 | =cut |
87 | |
88 | { package Log::Message::Handlers; |
89 | |
90 | sub msg { |
91 | my $self = shift; |
92 | my $verbose = shift || 0; |
93 | |
94 | ### so you don't want us to print the msg? ### |
95 | return if defined $verbose && $verbose == 0; |
96 | |
97 | my $old_fh = select $Log::Message::Simple::MSG_FH; |
98 | print '['. $self->tag (). '] ' . $self->message . "\n"; |
99 | select $old_fh; |
100 | |
101 | return; |
102 | } |
103 | |
104 | sub debug { |
105 | my $self = shift; |
106 | my $verbose = shift || 0; |
107 | |
108 | ### so you don't want us to print the msg? ### |
109 | return if defined $verbose && $verbose == 0; |
110 | |
111 | my $old_fh = select $Log::Message::Simple::DEBUG_FH; |
112 | print '['. $self->tag (). '] ' . $self->message . "\n"; |
113 | select $old_fh; |
114 | |
115 | return; |
116 | } |
117 | |
118 | sub error { |
119 | my $self = shift; |
120 | my $verbose = shift; |
121 | $verbose = 1 unless defined $verbose; # default to true |
122 | |
123 | ### so you don't want us to print the error? ### |
124 | return if defined $verbose && $verbose == 0; |
125 | |
126 | my $old_fh = select $Log::Message::Simple::ERROR_FH; |
127 | |
128 | my $msg = '['. $self->tag . '] ' . $self->message; |
129 | |
130 | print $Log::Message::Simple::STACKTRACE_ON_ERROR |
131 | ? Carp::shortmess($msg) |
132 | : $msg . "\n"; |
133 | |
134 | select $old_fh; |
135 | |
136 | return; |
137 | } |
138 | } |
139 | |
140 | =head2 carp(); |
141 | |
142 | Provides functionality equal to C<Carp::carp()>, whilst still logging |
143 | to the stack. |
144 | |
145 | Exported by by using the C<:CARP> tag. |
146 | |
147 | =head2 croak(); |
148 | |
149 | Provides functionality equal to C<Carp::croak()>, whilst still logging |
150 | to the stack. |
151 | |
152 | Exported by by using the C<:CARP> tag. |
153 | |
154 | =head2 confess(); |
155 | |
156 | Provides functionality equal to C<Carp::confess()>, whilst still logging |
157 | to the stack. |
158 | |
159 | Exported by by using the C<:CARP> tag. |
160 | |
161 | =head2 cluck(); |
162 | |
163 | Provides functionality equal to C<Carp::cluck()>, whilst still logging |
164 | to the stack. |
165 | |
166 | Exported by by using the C<:CARP> tag. |
167 | |
168 | =head1 CLASS METHODS |
169 | |
170 | =head2 Log::Message::Simple->stack() |
171 | |
172 | Retrieves all the items on the stack. Since C<Log::Message::Simple> is |
173 | implemented using C<Log::Message>, consult its manpage for the |
174 | function C<retrieve> to see what is returned and how to use the items. |
175 | |
176 | =head2 Log::Message::Simple->stack_as_string([TRACE]) |
177 | |
178 | Returns the whole stack as a printable string. If the C<TRACE> option is |
179 | true all items are returned with C<Carp::longmess> output, rather than |
180 | just the message. |
181 | C<TRACE> defaults to false. |
182 | |
183 | =head2 Log::Message::Simple->flush() |
184 | |
185 | Removes all the items from the stack and returns them. Since |
186 | C<Log::Message::Simple> is implemented using C<Log::Message>, consult its |
187 | manpage for the function C<retrieve> to see what is returned and how |
188 | to use the items. |
189 | |
190 | =cut |
191 | |
192 | BEGIN { |
193 | use Exporter; |
194 | use Params::Check qw[ check ]; |
195 | use vars qw[ @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ];; |
196 | |
197 | @ISA = 'Exporter'; |
198 | @EXPORT = qw[error msg debug]; |
199 | @EXPORT_OK = qw[carp cluck croak confess]; |
200 | |
201 | %EXPORT_TAGS = ( |
202 | STD => \@EXPORT, |
203 | CARP => \@EXPORT_OK, |
204 | ALL => [ @EXPORT, @EXPORT_OK ], |
205 | ); |
206 | |
207 | my $log = new Log::Message; |
208 | |
209 | for my $func ( @EXPORT, @EXPORT_OK ) { |
210 | no strict 'refs'; |
211 | |
212 | ### up the carplevel for the carp emulation |
213 | ### functions |
214 | *$func = sub { local $Carp::CarpLevel += 2 |
215 | if grep { $_ eq $func } @EXPORT_OK; |
216 | |
217 | my $msg = shift; |
218 | $log->store( |
219 | message => $msg, |
220 | tag => uc $func, |
221 | level => $func, |
222 | extra => [@_] |
223 | ); |
224 | }; |
225 | } |
226 | |
227 | sub flush { |
228 | return reverse $log->flush; |
229 | } |
230 | |
231 | sub stack { |
232 | return $log->retrieve( chrono => 1 ); |
233 | } |
234 | |
235 | sub stack_as_string { |
236 | my $class = shift; |
237 | my $trace = shift() ? 1 : 0; |
238 | |
239 | return join $/, map { |
240 | '[' . $_->tag . '] [' . $_->when . '] ' . |
241 | ($trace ? $_->message . ' ' . $_->longmess |
242 | : $_->message); |
243 | } __PACKAGE__->stack; |
244 | } |
245 | } |
246 | |
247 | =head1 GLOBAL VARIABLES |
248 | |
249 | =over 4 |
250 | |
251 | =item $ERROR_FH |
252 | |
253 | This is the filehandle all the messages sent to C<error()> are being |
254 | printed. This defaults to C<*STDERR>. |
255 | |
256 | =item $MSG_FH |
257 | |
258 | This is the filehandle all the messages sent to C<msg()> are being |
259 | printed. This default to C<*STDOUT>. |
260 | |
261 | =item $DEBUG_FH |
262 | |
263 | This is the filehandle all the messages sent to C<debug()> are being |
264 | printed. This default to C<*STDOUT>. |
265 | |
266 | =item $STACKTRACE_ON_ERROR |
267 | |
268 | If this option is set to C<true>, every call to C<error()> will |
269 | generate a stacktrace using C<Carp::shortmess()>. |
270 | Defaults to C<false> |
271 | |
272 | =cut |
273 | |
274 | BEGIN { |
275 | use vars qw[ $ERROR_FH $MSG_FH $DEBUG_FH $STACKTRACE_ON_ERROR ]; |
276 | |
277 | local $| = 1; |
278 | $ERROR_FH = \*STDERR; |
279 | $MSG_FH = \*STDOUT; |
280 | $DEBUG_FH = \*STDOUT; |
281 | |
282 | $STACKTRACE_ON_ERROR = 0; |
283 | } |
284 | |
285 | |
286 | 1; |
287 | |
288 | # Local variables: |
289 | # c-indentation-style: bsd |
290 | # c-basic-offset: 4 |
291 | # indent-tabs-mode: nil |
292 | # End: |
293 | # vim: expandtab shiftwidth=4: |