File Coverage

blib/lib/Dancer/Plugin/Dispatcher.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	10	14	71.4
condition	8	11	72.7
subroutine	5	5	100.0
pod			n/a
total	63	70	90.0

# ABSTRACT: Controller Class Dispatching System for Dancer
package Dancer::Plugin::Dispatcher;

use Beam::Wire;
use Dancer::Plugin;

use Dancer ':syntax';

our $VERSION = '0.13'; # VERSION

my %handlers;
my %services;

register dispatch => sub {
    my $config = plugin_setting;
    my ($self, @directions) = plugin_args(@_);

    my $caller    = caller(0) // 'main';
    my $container = Beam::Wire->new(config => $config->{services} // {});
    my $prefix    = $config->{prefix} // '';
    my $suffix    = $config->{suffix} // '';
    my $handlers  = [];

    for my $direction (@directions) {
        next if $handlers{$caller}{$direction};

        my ($service, $method) = split /#/, $direction;

        my $object = bless {}, $caller;
        $object = $services{$service} //= $container->get($service) if $service;
        $method = join '', $prefix, $method, $suffix;

        my $class = ref $object;
        my $code  = $object->can($method)
            or die "Class ($class) doesn't have method ($method)";

        $handlers{$caller}{$direction} = {
            class   => $class,
            service => $service,
            object  => $object,
            method  => $method,
            code    => $code,
        };
    }

    return sub {
        my $data; my @args = @_;
        for my $direction (@directions) {
            my $handler = $handlers{$caller}{$direction};
            my $class   = $handler->{class};
            my $service = $handler->{service};
            my $method  = $handler->{method};
            my $code    = $handler->{code};

            debug "Dispatching to class ($class) and method ($method)"
                . $service ? " using service ($service)" : "";

            $data = $code->(@args);

            # the dispatch chain will be broken and return immediately if a 3xx
            # series redirect is issued or if execution is explicitly halted
            if (my $response = Dancer::SharedData->response) {
                last if $response->status =~ /^3/; # redirect
                last if $response->halted; # halted
            }
        }
        return $data;
    }
};

register_plugin for_versions => [1, 2];

__END__