File Coverage

blib/lib/Plack/Test/Simple.pm

Criterion	Covered	Total	%
statement	43	46	93.4
branch	7	10	70.0
condition	5	15	33.3
subroutine	13	14	92.8
pod	1	2	50.0
total	69	87	79.3

# ABSTRACT: Object-Oriented PSGI Application Testing
package Plack::Test::Simple;

use utf8;

use Carp;
use HTTP::Request;
use HTTP::Response;
use Moo;
use Plack::Test::Simple::Transaction;
use Plack::Util;
use URI;

use JSON qw(encode_json);

our $VERSION = '0.02'; # VERSION

sub BUILDARGS {
    my ($class, @args) = @_;

    @args = @args == 1 ? 'HASH' eq ref $args[0] ?
        %{$args[0]} : ('psgi', @args) : @args;

    return {@args};
}

has request => (
    is      => 'rw',
    lazy    => 1,
    builder => 1
);

sub _build_request {
    return HTTP::Request->new(
        uri => URI->new(scheme => 'http', host => 'localhost', path => '/')
    )
}

has psgi => (
    is     => 'rw',
    isa    => sub {
        my $psgi = shift;

        die 'The psgi attribute must must be a valid PSGI filepath or code '.
            'reference' if !$psgi && ('CODE' eq ref($psgi) xor -f $psgi);
    },
    coerce => sub {
        my $psgi = shift;

        # return psgi
        return $psgi if (ref $psgi) =~ /Plack::Test::/; # very trusting
        return Plack::Test->create($psgi) if 'CODE' eq ref $psgi;
        return Plack::Test->create(Plack::Util::load_psgi($psgi));
    }
);

sub transaction {
    my ($self, $meth, $path, $cont) = @_;

    my $trans = Plack::Test::Simple::Transaction->new(
        psgi    => $self->psgi,
        request => $self->request->clone
    );

    $meth ||= 'get';
    $path ||= '/';

    $trans->request->method(uc $meth);
    $trans->request->uri(URI->new($path));

    if (defined $cont) {
        $trans->request->content(ref $cont ? encode_json($cont) : $cont);
    }

    return $trans;
}

sub AUTOLOAD {
    my ($self, @args)  = @_;
    my @cmds = split /_/, ($Plack::Test::Simple::AUTOLOAD =~ /.*::([^:]+)/)[0];

    return $self->transaction($cmds[0], @args[0,1])->status_is(
            $cmds[2], $args[2]
        )
        if  @cmds == 3
        && $cmds[0] =~ /^(get|post|put|delete|head|options|connect|patch|trace)$/
        && $cmds[1] eq 'returns'
        && $cmds[2] =~ /^\d{3}$/
    ;

    croak sprintf q(Can't locate object method "%s" via package "%s"),
        join('_', @cmds), ((ref $_[0] || $_[0]) || 'main')
}

sub DESTROY {
    # noop
}

1;

__END__