File Coverage

blib/lib/Atto.pm

Criterion	Covered	Total	%
statement	64	67	95.5
branch	18	32	56.2
condition	2	2	100.0
subroutine	11	11	100.0
pod	0	1	0.0
total	95	113	84.0

package Atto;
$Atto::VERSION = '0.002';
# 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);

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 (not $env->{REQUEST_METHOD})") unless $env->{REQUEST_METHOD} eq 'POST';

        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 $len = 0+($env->{CONTENT_LENGTH} || 0);

        my $args = {};
        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");
            }
        }

        # 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__