File: HTTPExceptions.pm

package info (click to toggle)
libplack-perl 0.9941-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,444 kB
  • ctags: 592
  • sloc: perl: 7,155; makefile: 2
file content (128 lines) | stat: -rw-r--r-- 2,981 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
package Plack::Middleware::HTTPExceptions;
use strict;
use parent qw(Plack::Middleware);

use Carp ();
use Try::Tiny;
use Scalar::Util 'blessed';
use HTTP::Status ();

sub call {
    my($self, $env) = @_;

    my $res = try {
        $self->app->($env);
    } catch {
        $self->transform_error($_, $env);
    };

    return $res if ref $res eq 'ARRAY';

    return sub {
        my $respond = shift;

        my $writer;
        try {
            $res->(sub { return $writer = $respond->(@_) });
        } catch {
            if ($writer) {
                Carp::cluck $_;
                $writer->close;
            } else {
                my $res = $self->transform_error($_, $env);
                $respond->($res);
            }
        };
    };
}

sub transform_error {
    my($self, $e, $env) = @_;

    my($code, $message);
    if (blessed $e && $e->can('code')) {
        $code = $e->code;
        $message =
            $e->can('as_string')       ? $e->as_string :
            overload::Method($e, '""') ? "$e"          : undef;
    } else {
        $code = 500;
        $env->{'psgi.errors'}->print($e);
    }

    if ($code !~ /^[3-5]\d\d$/) {
        die $e; # rethrow
    }

    my @headers = (
         'Content-Type'   => 'text/plain',
         'Content-Length' => length($message),
    );

    if ($code =~ /^3/ && (my $loc = eval { $e->location })) {
        push(@headers, Location => $loc);
    }

    $message ||= HTTP::Status::status_message($code);

    return [ $code, \@headers, [ $message ] ];
}

1;

__END__

=head1 NAME

Plack::Middleware::HTTPExceptions - Catch HTTP exceptions

=head1 SYNOPSIS

  use HTTP::Exception;

  my $app = sub {
      # ...
      HTTP::Exception::500->throw;
  };

  builder {
      enable "HTTPExceptions";
      $app;
  };

=head1 DESCRIPTION

Plack::Middleware::HTTPExceptions is a PSGI middleware component to
catch exceptions from applicaitions that can be translated into HTTP
status code.

Your application is supposed to throw an object that implements
C<code> method which returns the HTTP status code such as 501 or
404. This middleware catches them and creates a valid response out of
the code.

The exception object may also implement C<as_string>, or overload the
stringification, to represent the text of the error, which defaults to
the status message of error codes, such as I<Service Unavailable> for
C<503>.

If the code is in the 3xx range and the exception implements the 'location'
method (HTTP::Exception::3xx does), the Location header will be set in the
response, so you can do redirects this way.

There's a CPAN module L<HTTP::Exception> and they are pefect to throw
from your application to let this middleware catch and display, but
you can also implement your own exception class to throw.

All the other errors that can't be translated into HTTP errors are
just rethrown to the outer frame.

=head1 AUTHOR

Tatsuhiko Miyagawa

=head1 SEE ALSO

paste.httpexceptions L<HTTP::Exception>

=cut