view release on metacpan or  search on metacpan

lib/Router/Dumb.pm  view on Meta::CPAN

}

#pod =method add_route_unless_exists
#pod
#pod   $router->add_route_unless_exists(
#pod     Router::Dumb::Route->new({
#pod       parts  => [ qw( the :path parts ) ],
#pod       target => 'target-string',
#pod       ...
#pod     })
#pod   );
#pod
#pod This method adds a new L<route|Router::Dumb::Route> to the router unless it
#pod would conflict, in which case it does nothing.
#pod
#pod =cut

sub add_route_unless_exists {
  my ($self, $route) = @_;

  confess "invalid route" unless $route->isa('Router::Dumb::Route');

  my $npath = $route->normalized_path;
  return if $self->_route_at( $npath );

  $self->_add_route($npath, $route);
}

#pod =method route
#pod
#pod   my $match_or_undef = $router->route( $str );
#pod
#pod If the given string can be routed to a match, the L<match|Router::Dumb::Match>
#pod is returned.  If not, the method returns false.
#pod
#pod The string must begin with a C</>.
#pod
#pod =cut

sub route {
  my ($self, $str) = @_;

  # Shamelessly stolen from Path::Router 0.10 -- rjbs, 2011-07-13
  $str =~ s|/{2,}|/|g;                          # xx////xx  -> xx/xx
  $str =~ s{(?:/\.)+(?:/|\z)}{/}g;              # xx/././xx -> xx/xx
  $str =~ s|^(?:\./)+||s unless $str eq "./";   # ./xx      -> xx
  $str =~ s|^/(?:\.\./)+|/|;                    # /../../xx -> xx
  $str =~ s|^/\.\.$|/|;                         # /..       -> /
  $str =~ s|/\z|| unless $str eq "/";           # xx/       -> xx

  confess "path didn't start with /" unless $str =~ s{^/}{};

  if (my $route = $self->_route_at($str)) {
    # should always match! -- rjbs, 2011-07-13
    confess "empty route didn't match empty path"
      unless my $match = $route->check($str);

    return $match;
  }

  my @parts = split m{/}, $str;

  for my $candidate ($self->ordered_routes(
    sub {
         ($_->part_count == @parts and $_->has_params)
      or ($_->part_count <= @parts and $_->is_slurpy)
    }
  )) {
    next unless my $match = $candidate->check($str);
    return $match;
  }

  return;
}

has _route_map => (
  is   => 'ro',
  isa  => 'HashRef',
  init_arg => undef,
  default  => sub {  {}  },
  traits   => [ 'Hash' ],
  handles  => {
    _routes   => 'values',
    _route_at => 'get',
    _add_route => 'set',
  },
);

#pod =method ordered_routes
#pod
#pod   my @routes = $router->ordered_routes;
#pod
#pod This method returns the router's routes, in the order that they will be
#pod checked.  You probably do not want to use this method unless you really know
#pod what you're doing.
#pod
#pod =cut

sub ordered_routes {
  my ($self, $filter) = @_;

  return sort { $b->part_count <=> $a->part_count
             || $a->is_slurpy  <=> $b->is_slurpy }
         grep { $filter ? $filter->() : 1 }
         $self->_routes;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Router::Dumb - yet another dumb path router for URLs

=head1 VERSION