| HTTP-Router documentation | Contained in the HTTP-Router distribution. |
HTTP::Router::Route - Route Representation for HTTP::Router
use HTTP::Router;
use HTTP::Router::Route;
my $router = HTTP::Router->new;
my $route = HTTP::Router::Route->new(
path => '/',
conditions => { method => 'GET' },
params => { controller => 'Root', action => 'index' },
);
$router->add_route($route);
Returns a HTTP::Router::Match object, or undef
if route does not match a given request.
Appends path to route.
Adds parameters to route.
Adds conditions to route.
Extracts variable values from $path, and returns variable hash.
Returns a path which is processed with parameters.
Path string for route.
Route specific parameters.
Conditions for determining route.
URI::Template::Restrict representation with route path.
Size of splitting route path with slash.
Variable names in route path.
NAKAGAWA Masaki <masaki@cpan.org>
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| HTTP-Router documentation | Contained in the HTTP-Router distribution. |
package HTTP::Router::Route; use strict; use warnings; use base 'Class::Accessor::Fast'; use URI::Template::Restrict; use HTTP::Router::Match; use Scalar::Util (); __PACKAGE__->mk_accessors(qw'path params conditions'); sub new { my ($class, %args) = @_; return bless { path => '', params => {}, conditions => {}, %args, }, $class; } sub parts { my $self = shift; $self->{parts} ||= $self->path =~ tr!/!/!; } sub append_path { my ($self, $path) = @_; $self->{path} .= (defined $path ? $path : ''); } { no strict 'refs'; for my $name (qw'params conditions') { *{"add_${name}"} = sub { my ($self, %args) = @_; while (my ($key, $value) = each %args) { $self->$name->{$key} = $value; } }; } } sub templates { my $self = shift; $self->{templates} ||= URI::Template::Restrict->new($self->path); } { no strict 'refs'; for my $method (qw'variables extract') { *{$method} = sub { my ($self, @args) = @_; $self->templates->$method(@args); }; } } sub match { my ($self, $req) = @_; return unless Scalar::Util::blessed($req) and $req->can('path'); my $path = $req->path; defined $path or return; # path, captures my %captures; if ($self->variables) { my $size = $path =~ tr!/!/!; $size == $self->parts or return; # FIXME: ignore parts %captures = $self->extract($path) or return; $self->_is_valid_variables(\%captures) or return; } else { $path eq $self->path or return; } # conditions $self->_is_valid_request($req) or return; my %params = %captures; for my $key (keys %{ $self->params }) { next if exists $params{$key}; $params{$key} = $self->params->{$key}; } return HTTP::Router::Match->new( params => \%params, captures => \%captures, route => $self, ); } sub _is_valid_variables { my ($self, $vars) = @_; for my $name (keys %$vars) { return 0 unless $self->_validate($vars->{$name}, $self->conditions->{$name}); } return 1; } sub _is_valid_request { my ($self, $req) = @_; my $conditions = do { my %vars = map { $_ => 1 } $self->variables; [ grep { !$vars{$_} } keys %{ $self->conditions } ]; }; for my $name (@$conditions) { return 0 unless my $code = $req->can($name); my $value = $code->($req); if ($name eq 'method') { # HEAD equals to GET $value = 'GET' if $value eq 'HEAD'; } return 0 unless $self->_validate($value, $self->conditions->{$name}); } return 1; } sub _validate { my ($self, $input, $expected) = @_; # arguments return 0 unless defined $input; return 1 unless defined $expected; # validation return $input =~ $expected if ref $expected eq 'Regexp'; return grep { $input eq $_ } @$expected if ref $expected eq 'ARRAY'; return $input eq $expected; } sub uri_for { my ($self, $args) = @_; for my $name (keys %{ $args || {} }) { return unless $self->_validate($args->{$name}, $self->conditions->{$name}); } return $self->templates->process_to_string(%$args); } 1;