File Coverage

blib/lib/HTML/Mason/PSGIHandler.pm

Criterion	Covered	Total	%
statement	62	68	91.1
branch	6	16	37.5
condition			n/a
subroutine	16	16	100.0
pod	2	6	33.3
total	86	106	81.1

package HTML::Mason::PSGIHandler;
{
  $HTML::Mason::PSGIHandler::VERSION = '0.53';
}
use strict;
use 5.008_001;

use base qw( HTML::Mason::CGIHandler );
use CGI::PSGI;
use HTML::Mason::Exceptions;

sub new {
    my $class = shift;
    $class->SUPER::new(
        request_class => 'HTML::Mason::Request::PSGI',
        @_,
    );
}

sub as_psgi {
    my $self = shift;
    return sub { $self->handle_psgi( $_[0] ) };
}

sub new_psgi {
    my $class = shift;
    $class->new(@_)->as_psgi;
}

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

    my $p = {
        comp => $env->{PATH_INFO},
        cgi  => CGI::PSGI->new($env),
    };

    my $r = $self->create_delayed_object('cgi_request', cgi => $p->{cgi});
    $self->interp->set_global('$r', $r);

    my $output;
    $self->interp->out_method( \$output );
    $self->interp->delayed_object_params('request', cgi_request => $r);

    my %args = $self->request_args($r);

    my @result = $self->invoke_mason(\%args, $p);
    die if $@;

    return [ $r->psgi_header(-Status => $result[0]), [ defined $output ? $output : () ] ];
}

sub invoke_mason {
    my ($self, $args, $p) = @_;

    my @result;
    if (wantarray) {
        @result = eval { $self->interp->exec($p->{comp}, %$args) };
    } elsif ( defined wantarray ) {
        $result[0] = eval { $self->interp->exec($p->{comp}, %$args) };
    } else {
        eval { $self->interp->exec($p->{comp}, %$args) };
    }

    return @result;
}

sub HTML::Mason::FakeApache::psgi_header {
    my $self = shift;
    my $h = $self->headers_out;
    my $e = $self->err_headers_out;

    my %args = (tied(%$h)->cgi_headers, tied(%$e)->cgi_headers, @_);
    if (exists $h->{Location}) {
        %args = (%args, -Status => 302);
    }

    return $self->query->psgi_header(%args);
}

package HTML::Mason::Request::PSGI;
{
  $HTML::Mason::Request::PSGI::VERSION = '0.53';
}
use strict;
use base qw(HTML::Mason::Request::CGI);

use HTML::Mason::Exceptions;

sub exec {
    my $self = shift;
    my $r = $self->cgi_request;
    my $retval;

    eval { $retval = $self->HTML::Mason::Request::exec(@_) };

    if (my $err = $@) {
        $retval = isa_mason_exception($err, 'Abort')   ? $err->aborted_value
                : isa_mason_exception($err, 'Decline') ? $err->declined_value
                :                                        rethrow_exception $err;
    }

    return $retval;
}

package HTML::Mason::PSGIHandler;

1;
__END__