File Coverage

blib/lib/Atto.pm

Criterion	Covered	Total	%
statement	71	75	94.6
branch	21	36	58.3
condition	2	2	100.0
subroutine	12	12	100.0
pod	0	1	0.0
total	106	126	84.1

package Atto;
$Atto::VERSION = '0.003';
# ABSTRACT: A tiny microservice builder

use 5.008_001;
use warnings;
use strict;

use Carp qw(croak);
use JSON::MaybeXS ();
use WWW::Form::UrlEncoded qw(parse_urlencoded);
use Plack::Request;

my %methods_for_package;

sub import {
    my ($class, @methods) = @_;
    my $package = caller;
    $methods_for_package{$package} = { map { $_ => undef } @methods };
}

sub psgi {
    my $package = caller;

    my $methods = $methods_for_package{$package};
    for my $method (keys %$methods) {
        my $coderef = do { no strict 'refs'; *{$package.'::'.$method}{CODE} };
        croak "method $method not found in $package" unless $coderef;
        $methods->{$method} = $coderef;
    }

    my $json = JSON::MaybeXS->new->allow_nonref;

    my $response = sub {
        my ($code, $raw) = @_;
        my $body = [ eval { $json->encode($raw) } ];
        if ($@) {
            $code = 500;
            $body = [ $json->encode("couldn't encode response: $@") ];
        }

        [ $code, [ 'Content-type' => 'application/json' ], $body ]
    };

    sub {
        my ($env) = @_;

        return $response->(405, "request method must be POST or GET (not $env->{REQUEST_METHOD})") unless grep { $env->{REQUEST_METHOD} eq $_ } qw(POST GET);

        my ($method) = $env->{REQUEST_URI} =~ m{^/([^/?]+)};
        return $response->(400, "method not found in request URL") unless defined $method;

        return $response->(404, "method not found") unless $methods->{$method};

        my $args = {};

        if ($env->{REQUEST_METHOD} eq 'GET') {
            my $req = Plack::Request->new($env);
            %$args = $req->query_parameters->flatten;
        }

        elsif ($env->{REQUEST_METHOD} eq 'POST') {
            my $len = 0+($env->{CONTENT_LENGTH} || 0);

            if ($len > 0) {
                return $response->(400, "content type not provided") unless defined $env->{CONTENT_TYPE};

                if ($env->{CONTENT_TYPE} eq 'application/json') {
                    my $nread = $env->{'psgi.input'}->read(my $content, $len);
                    return $response->(400, sprintf("expected %d bytes (from content-length), got %d", $len, $nread)) if $nread != $len;

                    $args = eval { $json->decode($content) };
                    return $response->(400, $@) if $@;
                }
                elsif ($env->{CONTENT_TYPE} eq 'application/x-www-form-urlencoded') {
                    my $nread = $env->{'psgi.input'}->read(my $content, $len);
                    return $response->(400, sprintf("expected %d bytes (from content-length), got %d", $len, $nread)) if $nread != $len;

                    %$args = parse_urlencoded($content);
                    return $response->(400, $@) if $@;
                }
                else {
                    return $response->(400, "unknown content type");
                }
            }
        }

        else {
            return $response->(405, "request method must be POST or GET (not $env->{REQUEST_METHOD})");
        }


        # XXX prototypes

        my @args =
            ref $args eq 'ARRAY' ? @$args :
            ref $args eq 'HASH'  ? %$args :
            ($args);

        my $ret = eval { $methods->{$method}->(@args) };
        return $response->(500, "method call failed: $@") if $@;

        return $response->(200, $ret);
    }
}

1;
__END__