File Coverage

blib/lib/Dancer/Plugin/Dispatcher.pm

Criterion	Covered	Total	%
statement	65	65	100.0
branch	20	26	76.9
condition	7	14	50.0
subroutine	10	10	100.0
pod	0	3	0.0
total	102	118	86.4

# ABSTRACT: Simple yet Powerful Controller Class dispatcher for Dancer

package Dancer::Plugin::Dispatcher;
{
    $Dancer::Plugin::Dispatcher::VERSION = '0.12';
}

our $VERSION = '0.12';    # VERSION


use strict;
use warnings;
use Dancer qw/:syntax/;
use Dancer::Plugin;

our $CONTROLLERS;

# automation ... sorta

sub dispatcher {
    return unless config->{plugins};

    our $cfg  = config->{plugins}->{Dispatcher};
    our $base = $cfg->{base};

    # check for a base class in the configuration
    if ($base) {
        unless ($CONTROLLERS) {
            my $base_file = $base;
            $base_file =~ s/::/\//gi;
            $base_file .= '.pm';

            eval "require $base" unless $INC{$base_file};
            $CONTROLLERS->{$base}++;
        }
    }
    else {
        ($base) = caller(1);
        $base ||= 'main';
    }

    sub BUILDCODE {

        my $code;

        # define the input
        my $shortcut = shift;

        # format the shortcut
        my ($class, $action) = split /#/, $shortcut;
        if ($class) {

            # run through the filters
            $class = ucfirst $class;
            $class =~ s/([a-z])\-([a-z])/$1::\u$2/gpi;
            $class =~ s/([a-z])\_([a-z])/$1\u$2/gpi;

            # prepend base to class if applicable
            $class = join "::", $base, $class if $base;
        }
        else {

            $class = $base if $base;
        }

        # build the return code (+chain if specified)
        $code = sub {

            my $class_file = $class;
            $class_file =~ s/::/\//gi;
            $class_file .= '.pm';

            eval "require $class" unless $INC{$class_file};
            $CONTROLLERS->{$class_file}++;

            debug lc "dispatching $class -> $action";
            $class->$action(@_) if $class && $action;
        };

        return $code;

    }

    my @codes = map { BUILDCODE($_) } @_;
    my $code = sub {
        my @args = @_;
        my $data;
        foreach my $code (@codes) {

            # HOW I WISH IT COULD WORK
            #-- break if content is set
            #-- last if Dancer::SharedData->response->content;

            # HOW IT MUST WORK
            # execute code
            # break if content is returned or
            # if redirect was issued
            $data = $code->(@args);
            last if $data || Dancer::SharedData->response->status =~ /^3\d\d$/;
        }
        return $data;
    };

    return $code;
}

sub auto_dispatcher {
    return unless config->{plugins};

    our $cfg = config->{plugins}->{Dispatcher};
    foreach my $route (@{$cfg->{routes}}) {
        my $re = qr/([a-z,]+) *([^\s>]+) *> *(.*)/;
        my ($m, $r, $s) = $route =~ $re;
        foreach my $i (split /,/, $m) {
            if ($i && $r && $s) {
                my $c = dispatcher(split(/[\s,]/, $s));
                if ($i eq 'get') {
                    Dancer::App->current->registry->universal_add($_, $r, $c)
                      for ('get', 'head');
                }
                else {
                    Dancer::App->current->registry->universal_add($i, $r, $c);
                }
            }
        }
    }
}

register dispatch => sub { dispatcher @_ };

register_plugin;
auto_dispatcher;

1;

__END__