File Coverage

blib/lib/Dancer/Route/Registry.pm

Criterion	Covered	Total	%
statement	79	83	95.1
branch	20	24	83.3
condition	7	8	87.5
subroutine	14	15	93.3
pod	1	8	12.5
total	121	138	87.6

package Dancer::Route::Registry;
our $AUTHORITY = 'cpan:SUKRIA';
# ABSTRACT: Route registry for Dancer
$Dancer::Route::Registry::VERSION = '1.3514_04'; # TRIAL
$Dancer::Route::Registry::VERSION = '1.351404';
use strict;
use warnings;
use Carp;
use Dancer::Route;
use base 'Dancer::Object';
use Dancer::Logger;
use Dancer::Exception qw(:all);

Dancer::Route::Registry->attributes(qw( id ));

my $id = 1;

sub init {
    my ($self) = @_;

    unless (defined $self->{id}) {
        $self->id($id++);
    }

    # Routes are stored here.  Keys are route methods, and values are
    # arrays of routes.  Routes with options are stored in the
    # beginning of the array while routes without options are stored
    # at the end.
    $self->{routes} = {};

    # Keep track of the border between routes with and without
    # options, so that routes with options can be easily inserted into
    # its routes array.
    $self->{routes_border} = {};

    return $self;
}

sub is_empty {
    my ($self) = @_;
    for my $method ( keys %{ $self->routes } ) {
        return 0 if $self->routes($method);
    }
    return 1;
}

# replace any ':foo' by '(.+)' and stores all the named
# matches defined in $REG->{route_params}{$route}
sub routes {
    my ($self, $method) = @_;

    if ($method) {
        my $route = $self->{routes}{$method};
        return $route ? $route : [];
    }
    else {
        return $self->{routes};
    }
}

sub add_route {
    my ($self, $route) = @_;
    $self->{routes}{$route->method} ||= [];
    my @registered = @{$self->routes($route->method)};
    my $last       = $registered[-1];
    $route->set_previous($last) if defined $last;

    # Routes are stored in the order they are declared. However,
    # routes with options (such as ajax routes) are stored before
    # routes without options. This way, we can have the following
    # routes:
    #
    #   get  '/'    => sub {};
    #   get  qr{.*} => sub {};
    #   ajax '/'    => sub {};
    #   ajax qr{.*} => sub {};
    #
    # And the user won't have to declare the ajax routes before the
    # get routes.
    if (keys %{$route->{options}}) {
        splice @{$self->routes($route->method)},
               $self->{routes_border}{$route->method}++,
               0,
               $route;
    }
    else {
        push @{$self->routes($route->method)}, $route;
    }

    return $route;
}

# sugar for add_route

sub register_route {
    my ($self, %args) = @_;

    # look if the caller (where the route is declared) exists as a Dancer::App
    # object
    my ($package) = caller(2);
    if ($package && Dancer::App->app_exists($package)) {
        my $app = Dancer::App->get($package);
        my $route = Dancer::Route->new(prefix => $app->prefix, %args);
        return $app->registry->add_route($route);
    }
    else {

        # FIXME maybe this code is useless, drop it later if so
        my $route = Dancer::Route->new(%args);
        return $self->add_route($route);
    }
}

# sugar for Dancer.pm
# class, any, ARRAY(0x9864818), '/path', CODE(0x990ac88)
# or
# class, any, '/path', CODE(0x990ac88)
sub any_add {
    my ($self, $pattern, @rest) = @_;

    my @methods = qw(get post put patch delete options head);

    if (ref($pattern) eq 'ARRAY') {
        @methods = @$pattern;
        # 'get' defaults to 'get' and 'head'
        push @methods, 'head' if ((grep { $_ eq 'get' } @methods) and
                                 not (grep { $_ eq 'head' } @methods));
        $pattern = shift @rest;
    }

    raise core_route => "Syntax error, methods should be provided as an ARRAY ref"
      if grep {$_ eq $pattern} @methods;

    $self->universal_add($_, $pattern, @rest) for @methods;
    return scalar(@methods);
}

sub universal_add {
    my ($self, $method, $pattern, @rest) = @_;

    my %options;
    my $code;

    if (@rest == 1) {
        $code = $rest[0];
    }
    else {
        %options = %{$rest[0]};
        $code    = $rest[1];
    }

    my %route_args = (
        method  => $method,
        code    => $code,
        options => \%options,
        pattern => $pattern,
    );

    return $self->register_route(%route_args);
}

# look for a route in the given array
sub find_route {
    my ($self, $r, $reg) = @_;
    foreach my $route (@$reg) {
        return $route if $r->equals($route);
    }
    return;
}

1;

__END__