File Coverage

blib/lib/Mojolicious/Routes/Pattern.pm
Criterion Covered Total %
statement 109 109 100.0
branch 88 90 97.7
condition 35 39 89.7
subroutine 11 11 100.0
pod 5 5 100.0
total 248 254 97.6


line stmt bran cond sub pod time code
1             package Mojolicious::Routes::Pattern;
2 52     52   957 use Mojo::Base -base;
  52         141  
  52         418  
3              
4 52     52   428 use Carp qw(croak);
  52         183  
  52         116419  
5              
6             has [qw(constraints defaults types)] => sub { {} };
7             has [qw(placeholder_start type_start)] => ':';
8             has [qw(placeholders tree)] => sub { [] };
9             has quote_end => '>';
10             has quote_start => '<';
11             has [qw(regex unparsed)];
12             has relaxed_start => '#';
13             has wildcard_start => '*';
14              
15             sub match {
16 174     174 1 558 my ($self, $path, $detect) = @_;
17 174         425 my $captures = $self->match_partial(\$path, $detect);
18 174 100 100     1102 return !$path || $path eq '/' ? $captures : undef;
19             }
20              
21             sub match_partial {
22 17809     17809 1 32203 my ($self, $pathref, $detect) = @_;
23              
24             # Compile on demand
25 17809 100       41661 $self->_compile($detect) unless $self->{regex};
26              
27 17809 100       37217 return undef unless my @captures = $$pathref =~ $self->regex;
28 2661         8446 $$pathref = ${^POSTMATCH};
29 2661 100       7832 @captures = () if $#+ == 0;
30 2661         4210 my $captures = {%{$self->defaults}};
  2661         6645  
31 2661         4794 for my $placeholder (@{$self->placeholders}, 'format') {
  2661         6259  
32 2929 100       7336 last unless @captures;
33 371         859 my $capture = shift @captures;
34 371 100       1403 $captures->{$placeholder} = $capture if defined $capture;
35             }
36              
37 2661         8955 return $captures;
38             }
39              
40 1121 100   1121 1 5692 sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
41              
42             sub parse {
43 1034     1034 1 1900 my $self = shift;
44              
45 1034 100 100     3531 my $pattern = @_ % 2 ? (shift // '/') : '/';
46 1034         7158 $pattern =~ s!^/*|/+!/!g;
47 1034 100       3291 return $self->constraints({@_}) if $pattern eq '/';
48              
49 933         1863 $pattern =~ s!/$!!;
50 933         2875 return $self->constraints({@_})->_tokenize($pattern);
51             }
52              
53             sub render {
54 720     720 1 14031 my ($self, $values, $endpoint) = @_;
55              
56             # Placeholders can only be optional without a format
57 720         1354 my $optional = !(my $format = $values->{format});
58              
59 720         1152 my $str = '';
60 720         1040 for my $token (reverse @{$self->tree}) {
  720         1929  
61 787         2999 my ($op, $value) = @$token;
62 787         1234 my $part = '';
63              
64             # Text
65 787 100       1729 if ($op eq 'text') { ($part, $optional) = ($value, 0) }
  381 100       736  
66              
67             # Slash
68 216 100       514 elsif ($op eq 'slash') { $part = '/' unless $optional }
69              
70             # Placeholder
71             else {
72 190         406 my $name = $value->[0];
73 190         459 my $default = $self->defaults->{$name};
74 190   100     1147 $part = $values->{$name} // $default // '';
      100        
75 190 100 100     639 if (!defined $default || ($default ne $part)) { $optional = 0 }
  154 100       279  
76 22         54 elsif ($optional) { $part = '' }
77             }
78              
79 787         2043 $str = $part . $str;
80             }
81              
82             # Format can be optional
83 720 100 100     3958 return $endpoint && $format ? "$str.$format" : $str;
84             }
85              
86             sub _compile {
87 692     692   1507 my ($self, $detect) = @_;
88              
89 692         1969 my $constraints = $self->constraints;
90 692         1688 my $defaults = $self->defaults;
91 692         1778 my $types = $self->types;
92              
93 692         1440 my $block = my $regex = '';
94 692         1094 my $optional = 1;
95 692         1232 for my $token (reverse @{$self->tree}) {
  692         1660  
96 778         2669 my ($op, $value, $type) = @$token;
97 778         1184 my $part = '';
98              
99             # Text
100 778 100       1869 if ($op eq 'text') { ($part, $optional) = (quotemeta $value, 0) }
  553 100       1338  
101              
102             # Slash
103             elsif ($op eq 'slash') {
104 119 100       404 $regex = ($optional ? "(?:/$block)?" : "/$block") . $regex;
105 119         247 ($block, $optional) = ('', 1);
106 119         243 next;
107             }
108              
109             # Placeholder
110             else {
111 106 100 100     268 if ($value->[1]) { $part = _compile_req($types->{$value->[1]} // '?!') }
  7         78  
112 99 100       272 else { $part = $type ? $type eq 'relaxed' ? '([^/]+)' : '(.+)' : '([^/.]+)' }
    100          
113              
114             # Custom regex
115 106 100       347 if (my $c = $constraints->{$value->[0]}) { $part = _compile_req($c) }
  14         42  
116              
117             # Optional placeholder
118 106 100       324 exists $defaults->{$value->[0]} ? ($part .= '?') : ($optional = 0);
119             }
120              
121 659         1906 $block = $part . $block;
122             }
123              
124             # Not rooted with a slash
125 692 100       1973 $regex = $block . $regex if $block;
126              
127             # Format
128 692 100       3132 $regex .= _compile_format($constraints->{format}, exists $defaults->{format}) if $detect;
129              
130 692         12767 $self->regex(qr/^$regex/ps);
131             }
132              
133             sub _compile_format {
134 548     548   1678 my ($format, $has_default) = @_;
135              
136             # No regex
137 548 100       1651 return '' unless $format;
138              
139             # Default regex
140 45 100       220 return '/?(?:\.([^/]+))?$' if $format eq '1';
141              
142             # Compile custom regex
143 41         146 my $regex = '\.' . _compile_req($format);
144 41 100       204 return $has_default ? "/?(?:$regex)?\$" : "/?$regex\$";
145             }
146              
147             sub _compile_req {
148 62     62   128 my $req = shift;
149 62 100       226 return "($req)" if ref $req ne 'ARRAY';
150 47         227 return '(' . join('|', map {quotemeta} reverse sort @$req) . ')';
  75         384  
151             }
152              
153             sub _tokenize {
154 933     933   2121 my ($self, $pattern) = @_;
155              
156 933         2110 my $placeholders = $self->placeholders;
157 933         2358 my $type_start = $self->type_start;
158 933         2255 my $quote_end = $self->quote_end;
159 933         2257 my $quote_start = $self->quote_start;
160 933         2136 my $start = $self->placeholder_start;
161 933         2144 my $relaxed = $self->relaxed_start;
162 933         2199 my $wildcard = $self->wildcard_start;
163              
164 933         1931 my (@tree, $spec, $more);
165 933         4375 for my $char (split //, $pattern) {
166              
167             # Quoted
168 10283 50 100     64201 if ($char eq $quote_start) { push @tree, ['placeholder', ''] if ++$spec }
  30 100 100     104  
    100 66        
    100 66        
    100 66        
    100 66        
    100 100        
    100          
    100          
    100          
169 30         79 elsif ($char eq $quote_end) { $spec = $more = 0 }
170              
171             # Placeholder
172 83 100       334 elsif (!$more && $char eq $start) { push @tree, ['placeholder', ''] unless $spec++ }
173              
174             # Relaxed or wildcard (upgrade when quoted)
175             elsif (!$more && ($char eq $relaxed || $char eq $wildcard)) {
176 46 100       201 push @tree, ['placeholder', ''] unless $spec++;
177 46 100       189 $tree[-1][2] = $char eq $relaxed ? 'relaxed' : 'wildcard';
178             }
179              
180             # Slash
181             elsif ($char eq '/') {
182 1323         3468 push @tree, ['slash'];
183 1323         2510 $spec = $more = 0;
184             }
185              
186             # Placeholder
187 786         1377 elsif ($spec && ++$more) { $tree[-1][1] .= $char }
188              
189             # Text (optimize slash+text and *+text+slash+text)
190 6799         11307 elsif ($tree[-1][0] eq 'text') { $tree[-1][-1] .= $char }
191 875         3486 elsif (!$tree[-2] && $tree[-1][0] eq 'slash') { @tree = (['text', "/$char"]) }
192 281 50       910 elsif ($tree[-2] && $tree[-2][0] eq 'text' && $tree[-1][0] eq 'slash') { pop @tree && ($tree[-1][-1] .= "/$char") }
193 30         120 else { push @tree, ['text', $char] }
194             }
195              
196             # Placeholder types
197 933         2517 for my $token (reverse @tree) {
198 1219 100       2938 next unless $token->[0] eq 'placeholder';
199 147 100       1293 $token->[1] = $token->[1] =~ /^(.+)\Q$type_start\E(.+)$/ ? [$1, $2] : [$token->[1]];
200 147         513 unshift @$placeholders, $token->[1][0];
201             }
202              
203 933         2861 return $self->unparsed($pattern)->tree(\@tree);
204             }
205              
206             1;
207              
208             =encoding utf8
209              
210             =head1 NAME
211              
212             Mojolicious::Routes::Pattern - Route pattern
213              
214             =head1 SYNOPSIS
215              
216             use Mojolicious::Routes::Pattern;
217              
218             # Create pattern
219             my $pattern = Mojolicious::Routes::Pattern->new('/test/:name');
220              
221             # Match routes
222             my $captures = $pattern->match('/test/sebastian');
223             say $captures->{name};
224              
225             =head1 DESCRIPTION
226              
227             L is the core of L.
228              
229             =head1 ATTRIBUTES
230              
231             L implements the following attributes.
232              
233             =head2 constraints
234              
235             my $constraints = $pattern->constraints;
236             $pattern = $pattern->constraints({foo => qr/\w+/});
237              
238             Regular expression constraints.
239              
240             =head2 defaults
241              
242             my $defaults = $pattern->defaults;
243             $pattern = $pattern->defaults({foo => 'bar'});
244              
245             Default parameters.
246              
247             =head2 placeholder_start
248              
249             my $start = $pattern->placeholder_start;
250             $pattern = $pattern->placeholder_start(':');
251              
252             Character indicating a placeholder, defaults to C<:>.
253              
254             =head2 placeholders
255              
256             my $placeholders = $pattern->placeholders;
257             $pattern = $pattern->placeholders(['foo', 'bar']);
258              
259             Placeholder names.
260              
261             =head2 quote_end
262              
263             my $end = $pattern->quote_end;
264             $pattern = $pattern->quote_end('}');
265              
266             Character indicating the end of a quoted placeholder, defaults to C>.
267              
268             =head2 quote_start
269              
270             my $start = $pattern->quote_start;
271             $pattern = $pattern->quote_start('{');
272              
273             Character indicating the start of a quoted placeholder, defaults to C>.
274              
275             =head2 regex
276              
277             my $regex = $pattern->regex;
278             $pattern = $pattern->regex($regex);
279              
280             Pattern in compiled regular expression form.
281              
282             =head2 relaxed_start
283              
284             my $start = $pattern->relaxed_start;
285             $pattern = $pattern->relaxed_start('*');
286              
287             Character indicating a relaxed placeholder, defaults to C<#>.
288              
289             =head2 tree
290              
291             my $tree = $pattern->tree;
292             $pattern = $pattern->tree([['text', '/foo']]);
293              
294             Pattern in parsed form. Note that this structure should only be used very carefully since it is very dynamic.
295              
296             =head2 type_start
297              
298             my $start = $pattern->type_start;
299             $pattern = $pattern->type_start('|');
300              
301             Character indicating the start of a placeholder type, defaults to C<:>.
302              
303             =head2 types
304              
305             my $types = $pattern->types;
306             $pattern = $pattern->types({int => qr/[0-9]+/});
307              
308             Placeholder types.
309              
310             =head2 unparsed
311              
312             my $unparsed = $pattern->unparsed;
313             $pattern = $pattern->unparsed('/:foo/:bar');
314              
315             Raw unparsed pattern.
316              
317             =head2 wildcard_start
318              
319             my $start = $pattern->wildcard_start;
320             $pattern = $pattern->wildcard_start('*');
321              
322             Character indicating the start of a wildcard placeholder, defaults to C<*>.
323              
324             =head1 METHODS
325              
326             L inherits all methods from L and implements the following new ones.
327              
328             =head2 match
329              
330             my $captures = $pattern->match('/foo/bar');
331             my $captures = $pattern->match('/foo/bar', 1);
332              
333             Match pattern against entire path, format detection is disabled by default.
334              
335             =head2 match_partial
336              
337             my $captures = $pattern->match_partial(\$path);
338             my $captures = $pattern->match_partial(\$path, 1);
339              
340             Match pattern against path and remove matching parts, format detection is disabled by default.
341              
342             =head2 new
343              
344             my $pattern = Mojolicious::Routes::Pattern->new;
345             my $pattern = Mojolicious::Routes::Pattern->new('/users/:id');
346             my $pattern = Mojolicious::Routes::Pattern->new('/user/:id', id => qr/\d+/);
347             my $pattern = Mojolicious::Routes::Pattern->new(format => ['json', 'yaml']);
348              
349             Construct a new L object and L pattern if necessary.
350              
351             =head2 parse
352              
353             $pattern = $pattern->parse('/user/:id');
354             $pattern = $pattern->parse('/user/:id', id=> qr/\d+/);
355             $pattern = $pattern->parse(format => ['json', 'yaml']);
356              
357             Parse pattern.
358              
359             =head2 render
360              
361             my $path = $pattern->render({id => 24});
362             my $path = $pattern->render({id => 24}, 1);
363              
364             Render pattern into a path with parameters, format rendering is disabled by default.
365              
366             =head1 SEE ALSO
367              
368             L, L, L.
369              
370             =cut