File Coverage

blib/lib/Router/Simple/Route.pm

Criterion	Covered	Total	%
statement	76	76	100.0
branch	43	46	93.4
condition	11	13	84.6
subroutine	6	6	100.0
pod	0	2	0.0
total	136	143	95.1

package Router::Simple::Route;
use strict;
use warnings;
use Carp ();

use Class::Accessor::Lite 0.05 (
    rw => [qw(name dest on_match method host pattern)],
);

sub new {
    my $class = shift;

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

    my ($name, $pattern, $dest, $opt) = @_;
    Carp::croak("missing pattern") unless $pattern;
    my $row = +{
        name     => $name,
        dest     => $dest,
        on_match => $opt->{on_match},
    };
    if (my $method = $opt->{method}) {
        $method = [$method] unless ref $method;
        $row->{method} = $method;

        my $method_re = join '|', @{$method};
        $row->{method_re} = qr{^(?:$method_re)$};
    }
    if (my $host = $opt->{host}) {
        $row->{host} = $host;
        $row->{host_re} = ref $host ? $host : qr(^\Q$host\E$);
    }

    $row->{pattern} = $pattern;

    # compile pattern
    my @capture;
    $row->{pattern_re} = do {
        if (ref $pattern) {
            $row->{_regexp_capture} = 1;
            $pattern;
        } else {
            $pattern =~ s!
                \{((?:\{[0-9,]+\}|[^{}]+)+)\} | # /blog/{year:\d{4}}
                :([A-Za-z0-9_]+)              | # /blog/:year
                (\*)                          | # /blog/*/*
                ([^{:*]+)                       # normal string
            !
                if ($1) {
                    my ($name, $pattern) = split /:/, $1, 2;
                    push @capture, $name;
                    $pattern ? "($pattern)" : "([^/]+)";
                } elsif ($2) {
                    push @capture, $2;
                    "([^/]+)";
                } elsif ($3) {
                    push @capture, '__splat__';
                    "(.+)";
                } else {
                    quotemeta($4);
                }
            !gex;
            # for example, pattern '/comment/' will both match '/comment/' and '/comment'
            $pattern .= '?' if $opt->{directory_slash} and $pattern =~ m{\/$};
            qr{^$pattern$};
        }
    };
    $row->{capture} = \@capture;
    $row->{dest}  ||= +{};

    return bless $row, $class;
}

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

    if ($self->{host_re}) {
        unless ($env->{HTTP_HOST} =~ $self->{host_re}) {
            return undef;
        }
    }
    if (my @captured = ($env->{PATH_INFO} =~ $self->{pattern_re})) {
        my %args;
        my @splat;
        if ($self->{_regexp_capture}) {
            push @splat, @captured;
        } else {
            if (@{$self->{capture}} > 0 && scalar(@{$self->{capture}}) != scalar(@captured)) {
                # Should not contain parenthesis in regexp pattern
                #
                # Good: "/{date:(?:\d+)}"
                # Bad:  "/{date:(\d+)}"
                Carp::carp("Path pattern should not contain paren. This code may not works in future version of Router::Simple. : " . $self->{pattern});
            }

            for my $i (0..@{$self->{capture}}-1) {
                if ($self->{capture}->[$i] eq '__splat__') {
                    push @splat, $captured[$i];
                } else {
                    $args{$self->{capture}->[$i]} = $captured[$i];
                }
            }
        }
        if ($self->{method_re}) {
            unless (($env->{REQUEST_METHOD} || '') =~ $self->{method_re}) {
                $Router::Simple::_METHOD_NOT_ALLOWED = 1;
                return undef;
            }
        }
        my $match = +{
            %{$self->{dest}},
            %args,
            ( @splat ? ( splat => \@splat ) : () ),
        };
        if ($self->{on_match}) {
            my $ret = $self->{on_match}->($env, $match);
            return undef unless $ret;
        }
        return $match;
    }
    return undef;
}

1;
__END__