File Coverage

blib/lib/Test/HTTP/MockServer/Once/REST.pm

Criterion	Covered	Total	%
statement	13	68	19.1
branch	0	14	0.0
condition	1	12	8.3
subroutine	4	10	40.0
pod	3	3	100.0
total	21	107	19.6

package Test::HTTP::MockServer::Once::REST;
use strict;
use warnings;
use JSON::XS;

sub new {
    my ($class) = shift;
    $class = ref $class || $class;
    my %dispatch = @_;
    return bless { d => \%dispatch }, $class;
}

sub _wrapped_rest_call {
    my $self = shift;
    my $wrapped = shift;
    return sub {
        # this is the coderef invoked by MockServer
        my ($req, $res) = @_;
        my $input_content = $req->content;
        my $input_data;
        my $input_ct = $req->header("Content-type");
        if ($input_content && $input_ct && $input_ct eq 'application/json') {
            eval {
                $input_data = decode_json $req->content;
            };
            if ($@) {
                $res->code(400);
                $res->message('Malformed Request');
                $res->content($@);
                return;
            }
        }
        my $selected_key;
        my @captures;
        my $s = join " ", $req->method(), $req->uri()->canonical()->path();
        foreach my $key (keys %{$self->{d}}) {
            my $rx = $self->{d}{$key};
            if (@captures = ($s =~ $rx)) {
                $selected_key = $key;
                last;
            }
        }
        if (!$selected_key) {
            $res->code(404);
            $res->message('Page not found');
            $res->content("$s not found");
            return;
        }

        my $return_data = $wrapped->(
            $selected_key, $req, $res, \@captures, $input_data
        );

        if ($return_data) {
            my $a = $req->header('Accept');
            if ($a && $a eq 'application/json') {
                eval {
                    my $out = encode_json $return_data;
                    $res->header('Content-type', 'application/json');
                    $res->content($out);
                };
                if ($@) {
                    $res->code(500);
                    $res->message('Internal Server Error');
                    $res->content($@);
                    return;
                }
            } else {
                $res->code(400);
                $res->message('Malformed Request');
                $res->content("Only support Accept: application/json");
                return;
            }
        }
    };
}

sub wrap_object {
    my $self = shift;
    my $object = shift;
    return $self->_wrapped_rest_call(
        sub {
            my $key = shift;
            return $object->$key(@_);
        }
    );
}

sub wrap_hash {
    my $self = shift;
    my $hash = shift;
    return $self->_wrapped_rest_call(
        sub {
            my $key = shift;
            return $hash->{$key}->(@_)
        }
    );
}

1;

__END__