File Coverage

blib/lib/Dancer/Plugin/REST.pm

Criterion	Covered	Total	%
statement	34	41	82.9
branch	8	14	57.1
condition	2	11	18.1
subroutine	10	12	83.3
pod			n/a
total	54	78	69.2

package Dancer::Plugin::REST;
BEGIN {
  $Dancer::Plugin::REST::AUTHORITY = 'cpan:SUKRIA';
}
# ABSTRACT: A plugin for writing RESTful apps with Dancer
$Dancer::Plugin::REST::VERSION = '0.11';
use strict;
use warnings;

use Carp 'croak';
use Dancer ':syntax';
use Dancer::Plugin;

my $content_types = {
    json => 'application/json',
    yml  => 'text/x-yaml',
    xml  => 'application/xml',
};

our $default_serializer;

register prepare_serializer_for_format => sub {
    my $conf        = plugin_setting;
    my $serializers = (
        ($conf && exists $conf->{serializers})
        ? $conf->{serializers}
        : { 'json' => 'JSON',
            'yml'  => 'YAML',
            'xml'  => 'XML',
            'dump' => 'Dumper',
        }
    );

    hook 'before' => sub {
        # remember what was there before
        $default_serializer ||= setting 'serializer';

        my $format = params->{'format'} or return;

        my $serializer = $serializers->{$format}
            or return halt(
                Dancer::Error->new(
                    code    => 404,
                    title   => "unsupported format requested",
                    message => "unsupported format requested: " . $format
                )->render
            );

        set serializer => $serializer;

        # check if we were supposed to deserialize the request
        Dancer::Serializer->process_request(
            Dancer::SharedData->request
        );

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

    hook after => sub {
        # put it back the way it was
        set serializer => $default_serializer;
    }
};

my %triggers_map = (
    get    => \&get,
    update => \&put,
    create => \&post,
    delete => \&del,
);

register resource => sub {
    croak "resource invoked without arguments" unless @_;

    my ($resource, %triggers) = @_;

    while( my( $t, $sub ) = each %triggers ) {
        my $method = $triggers_map{$t}
            or croak "action '$t' not recognized";

        if ( $t eq 'create' ) {
            $method->( "/${resource}" => $triggers{$t} );
            $method->( "/${resource}.:format" => $triggers{$t} );
        }
        else {
            for my $ext ( '.:format', '' ) {
                $method->( "/${resource}/:id$ext" => $triggers{$t} );
            }
        }
    }

};

register send_entity => sub {
    # entity, status_code
    status($_[1] || 200);
    $_[0];
};

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',
);

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

    register $helper_name => sub {
        if ($code >= 400) {
            send_entity({error => $_[0]}, $code);
        }
        else {
            send_entity($_[0], $code);
        }
    };
}

register_plugin;
1;

__END__