1package Path::Dispatcher::Rule::Tokens; 2# ABSTRACT: predicate is a list of tokens 3 4our $VERSION = '1.08'; 5 6use Moo; 7use MooX::TypeTiny; 8use Types::Standard qw(Str ArrayRef Bool); 9 10extends 'Path::Dispatcher::Rule'; 11 12has tokens => ( 13 is => 'ro', 14 isa => ArrayRef, 15 required => 1, 16); 17 18has delimiter => ( 19 is => 'ro', 20 isa => Str, 21 default => ' ', 22); 23 24has case_sensitive => ( 25 is => 'ro', 26 isa => Bool, 27 default => 1, 28); 29 30sub _match_as_far_as_possible { 31 my $self = shift; 32 my $path = shift; 33 34 my @got = $self->tokenize($path->path); 35 my @expected = @{ $self->tokens }; 36 my @matched; 37 38 while (@got && @expected) { 39 my $expected = $expected[0]; 40 my $got = $got[0]; 41 42 last unless $self->_match_token($got, $expected); 43 44 push @matched, $got; 45 shift @expected; 46 shift @got; 47 } 48 49 return (\@matched, \@got, \@expected); 50} 51 52sub _match { 53 my $self = shift; 54 my $path = shift; 55 56 my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path); 57 58 return if @$expected; # didn't provide everything necessary 59 return if @$got && !$self->prefix; # had tokens left over 60 61 my $leftover = $self->untokenize(@$got); 62 63 return if !$matched; 64 65 return { 66 positional_captures => $matched, 67 leftover => $leftover, 68 }; 69} 70 71sub complete { 72 my $self = shift; 73 my $path = shift; 74 75 my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path); 76 return if @$got > 1; # had tokens leftover 77 return if !@$expected; # consumed all tokens 78 79 my $next = shift @$expected; 80 my $part = @$got ? shift @$got : ''; 81 my @completions; 82 83 for my $completion (ref($next) eq 'ARRAY' ? @$next : $next) { 84 next if ref($completion); 85 86 next unless substr($completion, 0, length($part)) eq $part; 87 push @completions, $self->untokenize(@$matched, $completion); 88 } 89 90 return @completions; 91} 92 93sub _each_token { 94 my $self = shift; 95 my $got = shift; 96 my $expected = shift; 97 my $callback = shift; 98 99 if (ref($expected) eq 'ARRAY') { 100 for my $alternative (@$expected) { 101 $self->_each_token($got, $alternative, $callback); 102 } 103 } 104 elsif (!ref($expected) || ref($expected) eq 'Regexp') { 105 $callback->($got, $expected); 106 } 107 else { 108 die "Unexpected token '$expected'"; # the irony is not lost on me :) 109 } 110} 111 112sub _match_token { 113 my $self = shift; 114 my $got = shift; 115 my $expected = shift; 116 117 my $matched = 0; 118 $self->_each_token($got, $expected, sub { 119 my ($g, $e) = @_; 120 if (!ref($e)) { 121 ($g, $e) = (lc $g, lc $e) if !$self->case_sensitive; 122 $matched ||= $g eq $e; 123 } 124 elsif (ref($e) eq 'Regexp') { 125 $matched ||= $g =~ $e; 126 } 127 }); 128 129 return $matched; 130} 131 132sub tokenize { 133 my $self = shift; 134 my $path = shift; 135 return grep { length } split $self->delimiter, $path; 136} 137 138sub untokenize { 139 my $self = shift; 140 my @tokens = @_; 141 return join $self->delimiter, 142 grep { length } 143 map { split $self->delimiter, $_ } 144 @tokens; 145} 146 147__PACKAGE__->meta->make_immutable; 148no Moo; 149 1501; 151 152__END__ 153 154=pod 155 156=encoding UTF-8 157 158=head1 NAME 159 160Path::Dispatcher::Rule::Tokens - predicate is a list of tokens 161 162=head1 VERSION 163 164version 1.08 165 166=head1 SYNOPSIS 167 168 my $rule = Path::Dispatcher::Rule::Tokens->new( 169 tokens => [ "comment", "show", qr/^\d+$/ ], 170 delimiter => '/', 171 block => sub { display_comment(shift->pos(3)) }, 172 ); 173 174 $rule->match("/comment/show/25"); 175 176=head1 DESCRIPTION 177 178Rules of this class use a list of tokens to match the path. 179 180=head1 ATTRIBUTES 181 182=head2 tokens 183 184Each token can be a literal string, a regular expression, or a list of either 185(which are taken to mean alternations). For example, the tokens: 186 187 [ 'ticket', [ 'show', 'display' ], [ qr/^\d+$/, qr/^#\w{3}/ ] ] 188 189first matches "ticket". Then, the next token must be "show" or "display". The 190final token must be a number or a pound sign followed by three word characters. 191 192The results are the tokens in the original string, as they were matched. If you 193have three tokens, then C<< match->pos(1) >> will be the string's first token 194("ticket"), C<< match->pos(2) >> its second ("display"), and C<< match->pos(3) 195>> its third ("#AAA"). 196 197Capture groups inside a regex token are completely ignored. 198 199=head2 delimiter 200 201A string that is used to tokenize the path. The delimiter must be a string 202because prefix matches use C<join> on unmatched tokens to return the leftover 203path. In the future this may be extended to support having a regex delimiter. 204 205The default is a space, but if you're matching URLs you probably want to change 206this to a slash. 207 208=head2 case_sensitive 209 210Decide whether the rule matching is case sensitive. Default is 1, case 211sensitive matching. 212 213=head1 SUPPORT 214 215Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Path-Dispatcher> 216(or L<bug-Path-Dispatcher@rt.cpan.org|mailto:bug-Path-Dispatcher@rt.cpan.org>). 217 218=head1 AUTHOR 219 220Shawn M Moore, C<< <sartak at bestpractical.com> >> 221 222=head1 COPYRIGHT AND LICENSE 223 224This software is copyright (c) 2020 by Shawn M Moore. 225 226This is free software; you can redistribute it and/or modify it under 227the same terms as the Perl 5 programming language system itself. 228 229=cut 230