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

package Plack::Middleware::ErrorDocument;
use strict;
use warnings;
use parent qw(Plack::Middleware);
use Plack::MIME;
use Plack::Util;
use Plack::Util::Accessor qw( subrequest );

use HTTP::Status qw(is_error);

sub call {
    my $self = shift;
    my $env  = shift;

    my $r = $self->app->($env);

    $self->response_cb($r, sub {
        my $r = shift;
        unless (is_error($r->[0]) && exists $self->{$r->[0]}) {
            return;
        }

        my $path = $self->{$r->[0]};
        if ($self->subrequest) {
            for my $key (keys %$env) {
                unless ($key =~ /^psgi/) {
                    $env->{'psgix.errordocument.' . $key} = $env->{$key};
                }
            }

            # TODO: What if SCRIPT_NAME is not empty?
            $env->{REQUEST_METHOD} = 'GET';
            $env->{REQUEST_URI}    = $path;
            $env->{PATH_INFO}      = $path;
            $env->{QUERY_STRING}   = '';
            delete $env->{CONTENT_LENGTH};

            my $sub_r = $self->app->($env);
            if ($sub_r->[0] == 200) {
                $r->[1] = $sub_r->[1];
                if (@$r == 3) {
                    $r->[2] = $sub_r->[2];
                }
                else {
                    my $full_sub_response = '';
                    Plack::Util::foreach($sub_r->[2], sub {
                        $full_sub_response .= $_[0];
                    });

                    my $returned;
                    return sub {
                        if ($returned) {
                            return defined($_[0]) ? '' : undef;
                        }
                        $returned = 1;
                        return $full_sub_response;
                    }
                }
            }
            # TODO: allow 302 here?
        } else {
            my $h = Plack::Util::headers($r->[1]);
            $h->remove('Content-Length');
            $h->remove('Content-Encoding');
            $h->remove('Transfer-Encoding');
            $h->set('Content-Type', Plack::MIME->mime_type($path));

            open my $fh, "<", $path or die "$path: $!";
            if ($r->[2]) {
                $r->[2] = $fh;
            } else {
                my $done;
                return sub {
                    unless ($done) {
                        $done = 1;
                        return join '', <$fh>;
                    }
                    return defined $_[0] ? '' : undef;
                };
            };
        }
    });
}

1;

__END__