File Coverage

blib/lib/Ouch.pm
Criterion Covered Total %
statement 63 66 95.4
branch 16 18 88.8
condition 9 12 75.0
subroutine 23 25 92.0
pod 18 18 100.0
total 129 139 92.8


line stmt bran cond sub pod time code
1 2     2   112213 use strict;
  2         4  
  2         45  
2 2     2   6 use warnings;
  2         2  
  2         81  
3             package Ouch;
4             $Ouch::VERSION = '0.0410';
5 2     2   7 use Carp qw(longmess shortmess);
  2         3  
  2         95  
6 2     2   7 use parent 'Exporter';
  2         3  
  2         11  
7 2     2   118 use overload bool => sub {1}, q{""} => 'scalar', fallback => 1;
  2     8   2  
  2         17  
  8         18  
8 2     2   126 use Scalar::Util qw(blessed);
  2         3  
  2         1231  
9              
10             our @EXPORT = qw(bleep ouch kiss hug barf);
11             our @EXPORT_OK = qw(try throw catch catch_all caught caught_all);
12             our %EXPORT_TAGS = ( traditional => [qw(try throw catch catch_all)], trytiny => [qw( throw caught caught_all )] );
13              
14             sub new {
15 6     6 1 477 my ($class, $code, $message, $data) = @_;
16 6         1593 bless {code => $code, message => $message, data => $data, shortmess => shortmess($message), trace => longmess($message) }, $class;
17             }
18              
19             sub try (&) {
20 4     4 1 5 my $try = shift;
21 4         5 eval { $try->() };
  4         5  
22 4         14 return $@;
23             }
24              
25             sub ouch {
26 5     5 1 2540 my ($code, $message, $data) = @_;
27 5         11 my $self = __PACKAGE__->new($code, $message, $data);
28 5         639 die $self;
29             }
30              
31             sub throw { # alias
32 2     2 1 6 ouch @_;
33             }
34              
35             sub kiss {
36 8     8 1 17 my ($code, $e) = @_;
37 8 100       20 $e = $@ if @_ < 2;
38 8 100 66     76 if (blessed $e && $e->isa('Ouch') && $e->code eq $code) {
      100        
39 4         13 return 1;
40             }
41 4         13 return 0;
42             }
43              
44             sub catch {
45 2     2 1 5 kiss @_;
46             }
47              
48             sub caught {
49 0     0 1 0 kiss @_;
50             }
51              
52             sub hug {
53 10 100   10 1 242 my $e = @_ ? $_[0] : $@;
54 10 100       26 return $e ? 1 : 0;
55             }
56              
57             sub catch_all {
58 2     2 1 5 hug @_;
59             }
60              
61             sub caught_all {
62 0     0 1 0 hug @_;
63             }
64              
65             sub bleep {
66 6 100   6 1 181 my $e = @_ ? $_[0] : $@;
67 6 100 66     45 if (blessed $e && $e->isa('Ouch')) {
68 3         5 return $e->message;
69             }
70             else {
71 3         4 my $message = "$e"; # force to string anyway
72 3 50       20 if ($message =~ m{^(.*)\s+at\s.*line\s\d+.}xms) {
73 3         34 return $1;
74             }
75             else {
76 0         0 return $message;
77             }
78             }
79             }
80              
81             sub barf {
82 2 50   2 1 1875 my $e = @_ ? $_[0] : $@;
83 2         2 my $code;
84 2 100 66     13 if (blessed $e && $e->isa('Ouch')) {
85 1         2 $code = $e->code;
86             }
87             else {
88 1         2 $code = 1;
89             }
90              
91 2         4 print STDERR bleep($e)."\n";
92 2         7 exit $code;
93             }
94              
95             sub scalar {
96 1     1 1 101 my $self = shift;
97 1         5 return $self->{shortmess};
98             }
99              
100             sub trace {
101 1     1 1 2 my $self = shift;
102 1         3 return $self->{trace};
103             }
104              
105             sub hashref {
106 1     1 1 3 my $self = shift;
107             return {
108             code => $self->{code},
109             message => $self->{message},
110             data => $self->{data},
111 1         6 };
112             }
113              
114             sub code {
115 9     9 1 234 my $self = shift;
116 9         100 return $self->{code};
117             }
118              
119             sub message {
120 4     4 1 3 my $self = shift;
121 4         48 return $self->{message};
122             }
123              
124             sub data {
125 1     1 1 2 my $self = shift;
126 1         3 return $self->{data};
127             }
128              
129             =head1 NAME
130              
131             Ouch - Exceptions that don't hurt.
132              
133             =head1 VERSION
134              
135             version 0.0410
136              
137             =head1 SYNOPSIS
138              
139             use Ouch;
140              
141             eval { ouch(404, 'File not found.'); };
142              
143             if (kiss 404) {
144             check_elsewhere();
145             }
146              
147             say $@; # These two lines do the
148             say $@->scalar; # same thing.
149              
150             =head1 DESCRIPTION
151              
152             Ouch provides a class for exception handling that doesn't require a lot of boilerplate, nor any up front definition. If L
153             is working for you, great! But if you want something that is faster, easier to use, requires less typing, and has no prereqs, but still gives
154             you much of that same functionality, then Ouch is for you.
155              
156             =head2 Why another exception handling module?
157              
158             It really comes down to L isn't enough for me, and L does what I want but makes me type way too much. Also, I tend to work on a lot of protocol-based systems that use error codes (HTTP, FTP, SMTP, JSON-RPC) rather than error classes, so that feels more natural to me. Consider the difference between these:
159              
160             B
161              
162             use Ouch;
163             ouch 404, 'File not found.', 'file';
164              
165             B
166              
167             use Exception::Class (
168             'FileNotFound' => {
169             fields => [ 'code', 'field' ],
170             },
171             );
172             FileNotFound->throw( error => 'File not found.', code => 404, field => 'file' );
173              
174             And if you want to catch the exception you're looking at:
175              
176             B
177              
178             if (kiss 404) {
179             # do something
180             }
181              
182             B
183              
184             my $e;
185             if ($e = Exception::Class->caught('FileNotFound')) {
186             # do something
187             }
188              
189             Those differences may not seem like a lot, but over any substantial program with lots of exceptions it can become a big deal.
190              
191             =head2 Usage
192              
193             Most of the time, all you need to do is:
194              
195             ouch $code, $message, $data;
196             ouch -32700, 'Parse error.', $request; # JSON-RPC 2.0 error
197             ouch 441, 'You need to specify an email address.', 'email'; # form processing error
198             ouch 'missing_param', 'You need to specify an email address.', 'email';
199              
200             You can also go long form if you prefer:
201              
202             die Ouch->new($code, $message, $data);
203              
204             If you want to rethrow an Ouch, you can simply C it.
205              
206             eval { ouch(404, 'File not found.'); } ;
207             die $@;
208              
209             =head2 Functional Interface
210              
211             =head3 ouch
212              
213             Some nice sugar instead of using the object oriented interface.
214              
215             ouch 2121, 'Did not do the big thing.';
216              
217             =over
218              
219             =item code
220              
221             An error code. An integer or string representing error type. Try to stick to codes used in whatever domain you happen to be working in. HTTP Status codes. JSON-RPC error codes, etc.
222              
223             =item message
224              
225             A human readable error message.
226              
227             =item data
228              
229             Optional. Anything you want to attach to the exception to help a developer catching it decide what to do. For example, if you're doing form processing, you might want this to be the name of the field that caused the exception.
230              
231             B Do not include objects or code refs in your data. This should only be stuff that is easily serializable like scalars, array refs, and hash refs.
232              
233             =back
234              
235             =head3 kiss
236              
237             Some nice sugar to trap an Ouch.
238              
239             if (kiss $code) {
240             # make it go
241             }
242              
243             =over
244              
245             =item code
246              
247             The code you're looking for.
248              
249             =item exception
250              
251             Optional. If you like you can pass the exception into C. If not, it will just use whatever is in C<$@>. You might want to do this if you've saved the exception before running another C, for example.
252              
253             =back
254              
255              
256             =head3 hug
257              
258             Some nice sugar to trap any exception.
259              
260             if (hug) {
261             # make it stop
262             }
263              
264             =over
265              
266             =item exception
267              
268             Optional. If you like you can pass the exception into C. If not, it will just use whatever is in C<$@>.
269              
270             =back
271              
272              
273             =head3 bleep
274              
275             A little sugar to make exceptions human friendly. Returns a clean error message from any exception, including an Ouch.
276              
277             File not found.
278              
279             Rather than:
280              
281             File not found. at /Some/File.pm line 63.
282              
283             =over
284              
285             =item exception
286              
287             Optional. If you like you can pass the exception into C. If not, it will just use whatever is in C<$@>.
288              
289             =back
290              
291             =head3 barf
292              
293             Calls C, and then exits with error code
294              
295             =over
296              
297             =item exception
298              
299             Optional. You can pass an exception into C which then gets passed to C otherwise it will use whatever's in C<$@>
300              
301             =back
302              
303              
304             =head2 Object-Oriented Interface
305              
306             =head3 new
307              
308             Constructor for the object-oriented interface. Takes the same parameters as C.
309              
310             Ouch->new($code, $message, $data);
311              
312             =head3 scalar
313              
314             Returns the scalar form of the error message:
315              
316             Crap! at /Some/File.pm line 43.
317              
318             Just as if you had done:
319              
320             die 'Crap!';
321              
322             Rather than:
323              
324             ouch $code, 'Crap!';
325              
326             =head3 trace
327              
328             Call this if you want the full stack trace that lead up to the ouch.
329              
330             =head3 hashref
331              
332             Returns a formatted hash reference of the exception, which can be useful for handing off to a serializer like L.
333              
334             {
335             code => $code,
336             message => $message,
337             data => $data,
338             }
339              
340             =head3 code
341              
342             Returns the C passed into the constructor.
343              
344             =head3 message
345              
346             Returns the C passed into the constructor.
347              
348             =head3 data
349              
350             Returns the C passed into the constructor.
351              
352             =head2 Try::Tiny
353              
354             Many Ouch users like to use Ouch with L.
355              
356             use Try::Tiny;
357             use Ouch;
358              
359             try {
360             ouch 404, 'File not found!';
361             }
362             catch {
363             if (kiss(401, $_)) {
364             # do something
365             }
366             else {
367             die $_; # rethrow
368             }
369             };
370              
371             Some users are sticks in the mud who can't bring themselves to C and C. For them, there is the C<:trytiny> interface. Here's how it works:
372              
373             use Try::Tiny;
374             use Ouch qw(:trytiny);
375              
376             try {
377             throw(404, 'File not found!';
378             }
379             catch {
380             if (caught(401, $_)) {
381             # do something
382             }
383             else {
384             die $_; # rethrow
385             }
386             };
387              
388             =head3 throw
389              
390             See C for details.
391              
392             =head3 caught
393              
394             See C for details.
395              
396             =head3 caught_all
397              
398             See C for details.
399              
400             =head1 DEPRECATED
401              
402             This functionality is deprecated and will be removed in a future release. Use Try::Tiny instead.
403              
404             =head2 Traditional Interface
405              
406             Some people just can't bring themselves to use the sugary cuteness of Ouch. For them there is the C<:traditional> interface. Here's how it works:
407              
408             use Ouch qw(:traditional);
409              
410             my $e = try {
411             throw 404, 'File not found.';
412             };
413              
414             if ( catch 404, $e ) {
415             # do the big thing
416             }
417             elsif ( catch_all $e ) {
418             # make it stop
419             }
420             else {
421             # make it go
422             }
423              
424             B C also populates C<$@>, and C and C will also use C<$@> if you don't specify an exception.
425              
426             =head3 try
427              
428             Returns an exception. Is basically just a nice wrapper around C.
429              
430             =over
431              
432             =item block
433              
434             Try accepts a code ref, anonymous subroutine, or a block.
435              
436             B You need a semi-colon at the end of a C block.
437              
438             =back
439              
440             =head3 throw
441              
442             Works exactly like C. See C for details.
443              
444             =head3 catch
445              
446             Works exactly like C. See C for details.
447              
448             =head3 catch_all
449              
450             Works exactly like C. See C for details.
451              
452              
453             =head1 REQUIREMENTS
454              
455             Requires Perl 5.12 or higher.
456              
457              
458              
459             =head1 SUPPORT
460              
461             =over
462              
463             =item Repository
464              
465             L
466              
467             =item Bug Reports
468              
469             L
470              
471             =back
472              
473              
474             =head1 SEE ALSO
475              
476             If you're looking for something lighter, check out L that ships with Perl. Or if you're looking for something heavier check out L.
477              
478             =head1 AUTHOR
479              
480             JT Smith
481              
482             =head1 LEGAL
483              
484             Ouch is Copyright 2011 Plain Black Corporation (L) and is licensed under the same terms as Perl itself.
485              
486             =cut
487              
488             1;