File Coverage

blib/lib/Plack/Middleware/ErrorDocument.pm
Criterion Covered Total %
statement 66 66 100.0
branch 18 22 81.8
condition 3 3 100.0
subroutine 9 9 100.0
pod 1 1 100.0
total 97 101 96.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::ErrorDocument;
2 2     2   12 use strict;
  2         2  
  2         50  
3 2     2   8 use warnings;
  2         4  
  2         46  
4 2     2   8 use parent qw(Plack::Middleware);
  2         3  
  2         10  
5 2     2   821 use Plack::MIME;
  2         5  
  2         56  
6 2     2   10 use Plack::Util;
  2         4  
  2         38  
7 2     2   10 use Plack::Util::Accessor qw( subrequest );
  2         3  
  2         9  
8              
9 2     2   767 use HTTP::Status qw(is_error);
  2         7772  
  2         885  
10              
11             sub call {
12 10     10 1 15 my $self = shift;
13 10         13 my $env = shift;
14              
15 10         56 my $r = $self->app->($env);
16              
17             $self->response_cb($r, sub {
18 10     10   14 my $r = shift;
19 10 100 100     31 unless (is_error($r->[0]) && exists $self->{$r->[0]}) {
20 6         50 return;
21             }
22              
23 4         51 my $path = $self->{$r->[0]};
24 4 100       17 if ($self->subrequest) {
25 2         17 for my $key (keys %$env) {
26 44 100       90 unless ($key =~ /^psgi/) {
27 26         60 $env->{'psgix.errordocument.' . $key} = $env->{$key};
28             }
29             }
30              
31             # TODO: What if SCRIPT_NAME is not empty?
32 2         7 $env->{REQUEST_METHOD} = 'GET';
33 2         4 $env->{REQUEST_URI} = $path;
34 2         2 $env->{PATH_INFO} = $path;
35 2         8 $env->{QUERY_STRING} = '';
36 2         4 delete $env->{CONTENT_LENGTH};
37              
38 2         5 my $sub_r = $self->app->($env);
39 2 50       11 if ($sub_r->[0] == 200) {
40 2         5 $r->[1] = $sub_r->[1];
41 2 100       5 if (@$r == 3) {
42 1         4 $r->[2] = $sub_r->[2];
43             }
44             else {
45 1         10 my $full_sub_response = '';
46             Plack::Util::foreach($sub_r->[2], sub {
47 1         5 $full_sub_response .= $_[0];
48 1         17 });
49              
50 1         3 my $returned;
51             return sub {
52 2 100       6 if ($returned) {
53 1 50       11 return defined($_[0]) ? '' : undef;
54             }
55 1         1 $returned = 1;
56 1         4 return $full_sub_response;
57             }
58 1         14 }
59             }
60             # TODO: allow 302 here?
61             } else {
62 2         15 my $h = Plack::Util::headers($r->[1]);
63 2         19 $h->remove('Content-Length');
64 2         11 $h->remove('Content-Encoding');
65 2         9 $h->remove('Transfer-Encoding');
66 2         13 $h->set('Content-Type', Plack::MIME->mime_type($path));
67              
68 2 50       81 open my $fh, "<", $path or die "$path: $!";
69 2 100       10 if ($r->[2]) {
70 1         13 $r->[2] = $fh;
71             } else {
72 1         2 my $done;
73             return sub {
74 2 100       6 unless ($done) {
75 1         2 $done = 1;
76 1         55 return join '', <$fh>;
77             }
78 1 50       3 return defined $_[0] ? '' : undef;
79 1         20 };
80             };
81             }
82 10         139 });
83             }
84              
85             1;
86              
87             __END__