line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Middleware::HTTPExceptions; |
2
|
2
|
|
|
2
|
|
161850
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
61
|
|
3
|
2
|
|
|
2
|
|
10
|
use parent qw(Plack::Middleware); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
14
|
|
4
|
2
|
|
|
2
|
|
85
|
use Plack::Util::Accessor qw(rethrow); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
7
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
8
|
use Carp (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
27
|
|
7
|
2
|
|
|
2
|
|
827
|
use Try::Tiny; |
|
2
|
|
|
|
|
3570
|
|
|
2
|
|
|
|
|
108
|
|
8
|
2
|
|
|
2
|
|
14
|
use Scalar::Util 'blessed'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
69
|
|
9
|
2
|
|
|
2
|
|
815
|
use HTTP::Status (); |
|
2
|
|
|
|
|
8119
|
|
|
2
|
|
|
|
|
931
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub prepare_app { |
12
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
13
|
2
|
50
|
50
|
|
|
19
|
$self->rethrow(1) if ($ENV{PLACK_ENV} || '') eq 'development'; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub call { |
17
|
7
|
|
|
7
|
1
|
18
|
my($self, $env) = @_; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $res = try { |
20
|
7
|
|
|
7
|
|
268
|
$self->app->($env); |
21
|
|
|
|
|
|
|
} catch { |
22
|
4
|
|
|
4
|
|
194
|
$self->transform_error($_, $env); |
23
|
7
|
|
|
|
|
65
|
}; |
24
|
|
|
|
|
|
|
|
25
|
7
|
100
|
|
|
|
115
|
return $res if ref $res eq 'ARRAY'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
return sub { |
28
|
3
|
|
|
3
|
|
6
|
my $respond = shift; |
29
|
|
|
|
|
|
|
|
30
|
3
|
|
|
|
|
5
|
my $writer; |
31
|
|
|
|
|
|
|
try { |
32
|
3
|
|
|
|
|
103
|
$res->(sub { return $writer = $respond->(@_) }); |
|
1
|
|
|
|
|
7
|
|
33
|
|
|
|
|
|
|
} catch { |
34
|
2
|
50
|
|
|
|
70
|
if ($writer) { |
35
|
0
|
|
|
|
|
0
|
Carp::cluck $_; |
36
|
0
|
|
|
|
|
0
|
$writer->close; |
37
|
|
|
|
|
|
|
} else { |
38
|
2
|
|
|
|
|
8
|
my $res = $self->transform_error($_, $env); |
39
|
2
|
|
|
|
|
5
|
$respond->($res); |
40
|
|
|
|
|
|
|
} |
41
|
3
|
|
|
|
|
24
|
}; |
42
|
3
|
|
|
|
|
20
|
}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub transform_error { |
46
|
6
|
|
|
6
|
0
|
18
|
my($self, $e, $env) = @_; |
47
|
|
|
|
|
|
|
|
48
|
6
|
|
|
|
|
10
|
my($code, $message); |
49
|
6
|
50
|
66
|
|
|
78
|
if (blessed $e && $e->can('as_psgi')) { |
50
|
0
|
|
|
|
|
0
|
return $e->as_psgi; |
51
|
|
|
|
|
|
|
} |
52
|
6
|
100
|
66
|
|
|
35
|
if (blessed $e && $e->can('code')) { |
53
|
5
|
|
|
|
|
18
|
$code = $e->code; |
54
|
5
|
50
|
|
|
|
55
|
$message = |
|
|
100
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$e->can('as_string') ? $e->as_string : |
56
|
|
|
|
|
|
|
overload::Method($e, '""') ? "$e" : undef; |
57
|
|
|
|
|
|
|
} else { |
58
|
1
|
50
|
|
|
|
4
|
if ($self->rethrow) { |
59
|
0
|
|
|
|
|
0
|
die $e; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
else { |
62
|
1
|
|
|
|
|
3
|
$code = 500; |
63
|
1
|
|
|
|
|
15
|
$env->{'psgi.errors'}->print($e); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
6
|
50
|
|
|
|
217
|
if ($code !~ /^[3-5]\d\d$/) { |
68
|
0
|
|
|
|
|
0
|
die $e; # rethrow |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
6
|
|
66
|
|
|
33
|
$message ||= HTTP::Status::status_message($code); |
72
|
|
|
|
|
|
|
|
73
|
6
|
|
|
|
|
34
|
my @headers = ( |
74
|
|
|
|
|
|
|
'Content-Type' => 'text/plain', |
75
|
|
|
|
|
|
|
'Content-Length' => length($message), |
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
|
78
|
6
|
100
|
66
|
|
|
51
|
if ($code =~ /^3/ && (my $loc = eval { $e->location })) { |
|
1
|
|
|
|
|
5
|
|
79
|
1
|
|
|
|
|
7
|
push(@headers, Location => $loc); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
6
|
|
|
|
|
58
|
return [ $code, \@headers, [ $message ] ]; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
__END__ |