File Coverage

blib/lib/Raisin.pm

Criterion	Covered	Total	%
statement	140	166	84.3
branch	32	48	66.6
condition	4	14	28.5
subroutine	33	35	94.2
pod	7	19	36.8
total	216	282	76.6

#!perl
#PODNAME: Raisin
#ABSTRACT: A REST API microframework for Perl.

use strict;
use warnings;

package Raisin;
$Raisin::VERSION = '0.94';
use Carp qw(croak carp longmess);
use HTTP::Status qw(:constants);
use Plack::Response;
use Plack::Util;

use Raisin::Request;
use Raisin::Routes;
use Raisin::Util;

use Raisin::Middleware::Formatter;
use Raisin::Encoder;
use Raisin::Decoder;

use Plack::Util::Accessor qw(
    middleware
    mounted
    routes

    decoder
    encoder
);

sub new {
    my ($class, %args) = @_;

    my $self = bless { %args }, $class;

    $self->middleware({});
    $self->mounted([]);
    $self->routes(Raisin::Routes->new);

    $self->decoder(Raisin::Decoder->new);
    $self->encoder(Raisin::Encoder->new);

    $self;
}

sub mount_package {
    my ($self, $package) = @_;
    push @{ $self->{mounted} }, $package;
    Plack::Util::load_class($package);
}

sub load_plugin {
    my ($self, $name, @args) = @_;
    return if $self->{loaded_plugins}{$name};

    my $class = Plack::Util::load_class($name, 'Raisin::Plugin');
    my $module = $self->{loaded_plugins}{$name} = $class->new($self);

    $module->build(@args);
}

sub add_middleware {
    my ($self, $name, @args) = @_;
    $self->{middleware}{$name} = \@args;
}

# Routes
sub add_route {
    my ($self, %params) = @_;
    $self->routes->add(%params);
}

# Resource description
sub resource_desc {
    my ($self, $ns, $desc) = @_;
    $self->{resource_desc}{$ns} = $desc if $desc;
    $self->{resource_desc}{$ns};
}

# Hooks
sub hook {
    my ($self, $name) = @_;
    $self->{hooks}{$name} || sub {};
}

sub add_hook {
    my ($self, $name, $code) = @_;
    $self->{hooks}{$name} = $code;
}

# Application
sub run {
    my $self = shift;
    my $psgi = sub { $self->psgi(@_) };

    $self->{allowed_methods} = $self->generate_allowed_methods;

    # Add middleware
    for my $class (keys %{ $self->{middleware} }) {
        # Make sure the middleware was not already loaded
        next if $self->{_loaded_middleware}->{$class}++;

        my $mw = Plack::Util::load_class($class, 'Plack::Middleware');
        my $args = $self->{middleware}{$class};
        $psgi = $mw->wrap($psgi, @$args);
    }

    $psgi = Raisin::Middleware::Formatter->wrap(
        $psgi,
        default_format => $self->default_format,
        format => $self->format,
        decoder => $self->decoder,
        encoder => $self->encoder,
        raisin => $self,
    );

    # load fallback logger (Raisin::Logger)
    $self->load_plugin('Logger', fallback => 1);

    return $psgi;
}

sub generate_allowed_methods {
    my $self = shift;

    my %allowed_methods_by_endpoint;

    # `options` for each `path`
    for my $path (keys %{ $self->routes->list }) {
        my $methods = join ', ',
            sort(keys(%{ $self->routes->list->{$path} }), 'OPTIONS');

        $self->add_route(
            method => 'OPTIONS',
            path => $path,
            code => sub {
                $self->res->headers([Allow => $methods]);
                undef;
            },
        );

        $allowed_methods_by_endpoint{$path} = $methods;
    }

    \%allowed_methods_by_endpoint;
}

sub psgi {
    my ($self, $env) = @_;

    # New for each response
    my $req = $self->req(Raisin::Request->new($env));
    my $res = $self->res(Plack::Response->new);

    # Generate API description
    if ($self->can('swagger_build_spec')) {
        $self->swagger_build_spec;
    }

    my $ret = eval {
        $self->hook('before')->($self);

        # Find a route
        my $route = $self->routes->find($req->method, $req->path);
        # The requested path exists but requested method not
        if (!$route && $self->{allowed_methods}{ $req->path }) {
            $res->status(HTTP_METHOD_NOT_ALLOWED);
            return $res->finalize;
        }
        # Nothing found
        elsif (!$route) {
            $res->status(HTTP_NOT_FOUND);
            return $res->finalize;
        }

        my $code = $route->code;
        if (!$code || ($code && ref($code) ne 'CODE')) {
            $self->log(error => "route ${ \$req->path } returns nothing or not CODE");

            $res->status(HTTP_INTERNAL_SERVER_ERROR);
            $res->body('Internal error');

            return $res->finalize;
        }

        $self->hook('before_validation')->($self);

        # Validation and coercion of declared params
        if (!$req->prepare_params($route->params, $route->named)) {
            $res->status(HTTP_BAD_REQUEST);
            $res->body('Invalid Parameters');
            return $res->finalize;
        }

        $self->hook('after_validation')->($self);

        # Evaluate an endpoint
        my $data = $code->($req->declared_params);
        if (defined $data) {
            # Delayed response
            return $data if ref($data) eq 'CODE';

            $res->body($data);
        }

        $self->hook('after')->($self);

        1;
    } or do {
        my ($e) = longmess($@);
        $self->log(error => $e);

        my $msg = $ENV{PLACK_ENV}
            && $ENV{PLACK_ENV} eq 'deployment' ? 'Internal Error' : $e;

        $res->status(HTTP_INTERNAL_SERVER_ERROR);
        $res->body($msg);
    };

    if (ref($ret) eq 'CODE') {
        return $ret;
    }

    $self->finalize;
}

# Finalize response
sub before_finalize {
    my $self = shift;

    $self->res->status(HTTP_OK) unless $self->res->status;
    $self->res->header('X-Framework' => 'Raisin ' . (__PACKAGE__->VERSION || 'dev'));

    if ($self->api_version) {
        $self->res->header('X-API-Version' => $self->api_version);
    }
}

sub finalize {
    my $self = shift;
    $self->before_finalize;
    $self->res->finalize;
}

# Application defaults
sub default_format {
    my ($self, $format) = @_;

    if ($format) {
        $self->{default_format} = $format;
    }

    $self->{default_format} || 'yaml';
}

sub format {
    my ($self, $format) = @_;

    if ($format) {
        my @decoders = keys %{ $self->decoder->all };

        if (grep { lc($format) eq $_ } @decoders) {
            $self->{format} = lc $format;
            $self->default_format(lc $format);
        }
        else {
            carp 'Invalid format, choose one of: ', join(', ', @decoders);
        }
    }

    $self->{format};
}

sub api_version {
    my ($self, $version) = @_;
    $self->{version} = $version if $version;
    $self->{version}
}

# Request and Response and shortcuts
sub req {
    my ($self, $req) = @_;
    $self->{req} = $req if $req;
    $self->{req};
}

sub res {
    my ($self, $res) = @_;
    $self->{res} = $res if $res;
    $self->{res};
}

sub session {
    my $self = shift;

    if (not $self->req->env->{'psgix.session'}) {
        croak "No Session middleware wrapped";
    }

    $self->req->session;
}

1;

__END__