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