File Coverage

blib/lib/Router/Simple.pm

Criterion	Covered	Total	%
statement	56	67	83.5
branch	10	14	71.4
condition	7	13	53.8
subroutine	14	15	93.3
pod	6	6	100.0
total	93	115	80.8

package Router::Simple;
use strict;
use warnings;
use 5.00800;
our $VERSION = '0.16';
use Router::Simple::SubMapper;
use Router::Simple::Route;
use List::Util qw/max/;
use Carp ();

use Class::Accessor::Lite 0.05 (
    new => 1,
    ro => [qw(routes directory_slash)],
);

our $_METHOD_NOT_ALLOWED;

sub connect {
    my $self = shift;

    if ($self->{directory_slash}) {
        # connect([$name, ]$pattern[, \%dest[, \%opt]])
        if (@_ == 1 || ref $_[1]) {
            unshift(@_, undef);
        }

        # \%opt
        $_[3] ||= {};
        $_[3]->{directory_slash} = 1;
    }

    my $route = Router::Simple::Route->new(@_);
    push @{ $self->{routes} }, $route;
    return $self;
}

sub submapper {
    my ($self, $pattern, $dest, $opt) = @_;
    return Router::Simple::SubMapper->new(
        parent  => $self,
        pattern => $pattern,
        dest    => $dest || +{},
        opt     => $opt || +{},
    );
}

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

    if (ref $env) {
        # "I think there was a discussion about that a while ago and it is up to apps to deal with empty PATH_INFO as root / iirc"
        # -- by @miyagawa
        #
        # see http://blog.64p.org/entry/2012/10/05/132354
        if ($env->{PATH_INFO} eq '') {
            $env->{PATH_INFO} = '/';
        }
    } else {
        $env = +{ PATH_INFO => $env }
    }

    local $_METHOD_NOT_ALLOWED;
    $self->{method_not_allowed} = 0;
    for my $route (@{$self->{routes}}) {
        my $match = $route->match($env);
        return ($match, $route) if $match;
    }
    $self->{method_not_allowed} = $_METHOD_NOT_ALLOWED;
    return undef; # not matched.
}

sub method_not_allowed {
    my $self = shift;
    $self->{method_not_allowed};
}

sub match {
    my ($self, $req) = @_;
    my ($match) = $self->_match($req);
    return $match;
}

sub routematch {
    my ($self, $req) = @_;
    return $self->_match($req);
}

sub as_string {
    my $self = shift;

    my $mn = max(map { $_->{name} ? length($_->{name}) : 0 } @{$self->{routes}});
    my $nn = max(map { $_->{method} ? length(join(",",@{$_->{method}})) : 0 } @{$self->{routes}});

    return join('', map {
        sprintf "%-${mn}s %-${nn}s %s\n", $_->{name}||'', join(',', @{$_->{method} || []}) || '', $_->{pattern}
    } @{$self->{routes}}) . "\n";
}

1;
__END__