File Coverage

blib/lib/Dancer2/Plugin/REST.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	8	10	80.0
condition	9	14	64.2
subroutine	11	11	100.0
pod	2	3	66.6
total	74	82	90.2

package Dancer2::Plugin::REST;
our $AUTHORITY = 'cpan:SUKRIA';
# ABSTRACT: A plugin for writing RESTful apps with Dancer2
$Dancer2::Plugin::REST::VERSION = '1.00';
use strict;
use warnings;

use Carp;

use Dancer2::Plugin;

# [todo] - add XML support
my $content_types = {
    json => 'application/json',
    yml  => 'text/x-yaml',
};

has '+app' => (
    handles => [qw/
        add_hook
        add_route
        setting
        response
        request
        send_error
        set_response
    /],
);

sub prepare_serializer_for_format :PluginKeyword {
    my $self = shift;

    my $conf        = $self->config;
    my $serializers = (
        ($conf && exists $conf->{serializers})
        ? $conf->{serializers}
        : { 'json' => 'JSON',
            'yml'  => 'YAML',
            'dump' => 'Dumper',
        }
    );

    $self->add_hook( Dancer2::Core::Hook->new(
        name => 'before',
        code => sub {
            my $format = $self->request->params->{'format'};
            $format  ||= $self->request->captures->{'format'} if $self->request->captures;

            return delete $self->response->{serializer}
                unless defined $format;

            my $serializer = $serializers->{$format}
                or return $self->send_error("unsupported format requested: " . $format, 404);

            $self->setting(serializer => $serializer);

            $self->set_response( Dancer2::Core::Response->new(
                %{ $self->response },
                serializer => $self->setting('serializer'),
            ) );

            $self->response->content_type(
                $content_types->{$format} || $self->setting('content_type')
            );
        }
    ) );
};

sub resource :PluginKeyword {
    my ($self, $resource, %triggers) = @_;

    my %actions = (
        update => 'put',
        create => 'post',
        map { $_ => $_ } qw/ get delete /
    );

    croak "resource should be given with triggers"
      unless defined $resource
             and grep { $triggers{$_} } keys %actions;

    while( my( $action, $code ) = each %triggers ) {
            $self->add_route(
                method => $actions{$action},
                regexp => $_,
                code   => $code,
            ) for map { sprintf $_, '/:id' x ($action ne 'create') }
                        "/${resource}%s.:format", "/${resource}%s";
    }
};

sub send_entity :PluginKeyword {
    my ($self, $entity, $http_code) = @_;

    $self->response->status($http_code || 200);
    $entity;
};

# TODO refactor that if my patch goes for Dancer2::Core::HTTP
my %http_codes = (

    # 1xx
    100 => 'Continue',
    101 => 'Switching Protocols',
    102 => 'Processing',

    # 2xx
    200 => 'OK',
    201 => 'Created',
    202 => 'Accepted',
    203 => 'Non-Authoritative Information',
    204 => 'No Content',
    205 => 'Reset Content',
    206 => 'Partial Content',
    207 => 'Multi-Status',
    210 => 'Content Different',

    # 3xx
    300 => 'Multiple Choices',
    301 => 'Moved Permanently',
    302 => 'Found',
    303 => 'See Other',
    304 => 'Not Modified',
    305 => 'Use Proxy',
    307 => 'Temporary Redirect',
    310 => 'Too many Redirect',

    # 4xx
    400 => 'Bad Request',
    401 => 'Unauthorized',
    402 => 'Payment Required',
    403 => 'Forbidden',
    404 => 'Not Found',
    405 => 'Method Not Allowed',
    406 => 'Not Acceptable',
    407 => 'Proxy Authentication Required',
    408 => 'Request Time-out',
    409 => 'Conflict',
    410 => 'Gone',
    411 => 'Length Required',
    412 => 'Precondition Failed',
    413 => 'Request Entity Too Large',
    414 => 'Request-URI Too Long',
    415 => 'Unsupported Media Type',
    416 => 'Requested range unsatisfiable',
    417 => 'Expectation failed',
    418 => 'Teapot',
    422 => 'Unprocessable entity',
    423 => 'Locked',
    424 => 'Method failure',
    425 => 'Unordered Collection',
    426 => 'Upgrade Required',
    449 => 'Retry With',
    450 => 'Parental Controls',

    # 5xx
    500 => 'Internal Server Error',
    501 => 'Not Implemented',
    502 => 'Bad Gateway',
    503 => 'Service Unavailable',
    504 => 'Gateway Time-out',
    505 => 'HTTP Version not supported',
    507 => 'Insufficient storage',
    509 => 'Bandwidth Limit Exceeded',
);

plugin_keywords map {
    my $code = $_;
    my $helper_name = lc($http_codes{$_});
    $helper_name =~ s/[^\w]+/_/gms;
    $helper_name = "status_${helper_name}";

    $helper_name => sub {
        $_[0]->send_entity(
            ( $code >= 400 ? {error => $_[1]} : $_[1] ),
            $code
        );
    };
} keys %http_codes;

1;

__END__