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__
=for stopwords dest
=head1 NAME
Router::Simple::Route - route object
=head1 DESCRIPTION
This class represents route.
=head1 ATTRIBUTES
This class provides following attributes.
=over 4
=item name
=item dest
=item on_match
=item method
=item host
=item pattern
=back
=head1 SEE ALSO
L<Router::Simple>