File Coverage

blib/lib/Mojolicious/Routes/Pattern.pm
Criterion Covered Total %
statement 107 107 100.0
branch 84 86 97.6
condition 37 41 90.2
subroutine 11 11 100.0
pod 5 5 100.0
total 244 250 97.6


line stmt bran cond sub pod time code
1             package Mojolicious::Routes::Pattern;
2 48     48   820 use Mojo::Base -base;
  48         104  
  48         346  
3              
4 48     48   323 use Carp 'croak';
  48         171  
  48         89424  
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 66     66 1 275 my ($self, $path, $detect) = @_;
17 66         162 my $captures = $self->match_partial(\$path, $detect);
18 66 100 100     540 return !$path || $path eq '/' ? $captures : undef;
19             }
20              
21             sub match_partial {
22 15323     15323 1 28211 my ($self, $pathref, $detect) = @_;
23              
24             # Compile on demand
25 15323 100       35094 $self->_compile($detect) unless $self->{regex};
26              
27 15323 100       31796 return undef unless my @captures = $$pathref =~ $self->regex;
28 1861         5999 $$pathref = ${^POSTMATCH};
29 1861 100       5559 @captures = () if $#+ == 0;
30 1861         3202 my $captures = {%{$self->defaults}};
  1861         4684  
31 1861         3385 for my $placeholder (@{$self->placeholders}, 'format') {
  1861         4264  
32 2050 100       5141 last unless @captures;
33 791         1658 my $capture = shift @captures;
34 791 100       2560 $captures->{$placeholder} = $capture if defined $capture;
35             }
36              
37 1861         6431 return $captures;
38             }
39              
40 830 100   830 1 3358 sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
41              
42             sub parse {
43 761     761 1 1391 my $self = shift;
44              
45 761 100 100     2791 my $pattern = @_ % 2 ? (shift // '/') : '/';
46 761         5026 $pattern =~ s!^/*|/+!/!g;
47 761 100       2292 return $self->constraints({@_}) if $pattern eq '/';
48              
49 672         1343 $pattern =~ s!/$!!;
50 672         1893 return $self->constraints({@_})->_tokenize($pattern);
51             }
52              
53             sub render {
54 652     652 1 9907 my ($self, $values, $endpoint) = @_;
55              
56 652         1410 my $start = $self->type_start;
57              
58             # Placeholders can only be optional without a format
59 652         1337 my $optional = !(my $format = $values->{format});
60              
61 652         1066 my $str = '';
62 652         890 for my $token (reverse @{$self->tree}) {
  652         1416  
63 711         1915 my ($op, $value) = @$token;
64 711         1039 my $part = '';
65              
66             # Text
67 711 100       1507 if ($op eq 'text') { ($part, $optional) = ($value, 0) }
  343 100       663  
68              
69             # Slash
70 197 100       438 elsif ($op eq 'slash') { $part = '/' unless $optional }
71              
72             # Placeholder
73             else {
74 171   100     2273 my $name = (split $start, $value)[0] // '';
75 171         630 my $default = $self->defaults->{$name};
76 171   100     559 $part = $values->{$name} // $default // '';
      100        
77 171 100 100     557 if (!defined $default || ($default ne $part)) { $optional = 0 }
  143 100       271  
78 14         28 elsif ($optional) { $part = '' }
79             }
80              
81 711         1780 $str = $part . $str;
82             }
83              
84             # Format can be optional
85 652 100 100     3594 return $endpoint && $format ? "$str.$format" : $str;
86             }
87              
88             sub _compile {
89 597     597   1324 my ($self, $detect) = @_;
90              
91 597         1519 my $placeholders = $self->placeholders;
92 597         1569 my $constraints = $self->constraints;
93 597         1466 my $defaults = $self->defaults;
94 597         1618 my $start = $self->type_start;
95 597         1572 my $types = $self->types;
96              
97 597         1192 my $block = my $regex = '';
98 597         998 my $optional = 1;
99 597         1016 for my $token (reverse @{$self->tree}) {
  597         1463  
100 671         1942 my ($op, $value, $type) = @$token;
101 671         1086 my $part = '';
102              
103             # Text
104 671 100       1576 if ($op eq 'text') { ($part, $optional) = (quotemeta $value, 0) }
  469 100       1123  
105              
106             # Slash
107             elsif ($op eq 'slash') {
108 106 100       284 $regex = ($optional ? "(?:/$block)?" : "/$block") . $regex;
109 106         205 ($block, $optional) = ('', 1);
110 106         237 next;
111             }
112              
113             # Placeholder
114             else {
115 96 100       642 if ($value =~ /^(.+)\Q$start\E(.+)$/) {
116 5   100     35 ($value, $part) = ($1, _compile_req($types->{$2} // '?!'));
117             }
118             else {
119 91 100       254 $part = $type ? $type eq 'relaxed' ? '([^/]+)' : '(.+)' : '([^/.]+)';
    100          
120             }
121 96         234 unshift @$placeholders, $value;
122              
123             # Custom regex
124 96 100       262 if (my $c = $constraints->{$value}) { $part = _compile_req($c) }
  12         33  
125              
126             # Optional placeholder
127 96 100       320 exists $defaults->{$value} ? ($part .= '?') : ($optional = 0);
128             }
129              
130 565         1617 $block = $part . $block;
131             }
132              
133             # Not rooted with a slash
134 597 100       1672 $regex = $block . $regex if $block;
135              
136             # Format
137             $regex .= _compile_format($constraints->{format}, $defaults->{format})
138 597 100       2743 if $detect;
139              
140 597         15807 $self->regex(qr/^$regex/ps);
141             }
142              
143             sub _compile_format {
144 469     469   1616 my ($format, $default) = @_;
145              
146             # Default regex
147 469 100       1684 return '/?(?:\.([^/]+))?$' unless defined $format;
148              
149             # No regex
150 21 100       61 return '' unless $format;
151              
152             # Compile custom regex
153 9         26 my $regex = '\.' . _compile_req($format);
154 9 100       35 return $default ? "/?(?:$regex)?\$" : "/?$regex\$";
155             }
156              
157             sub _compile_req {
158 26     26   50 my $req = shift;
159 26 100       119 return "($req)" if ref $req ne 'ARRAY';
160 14         62 return '(' . join('|', map {quotemeta} reverse sort @$req) . ')';
  26         103  
161             }
162              
163             sub _tokenize {
164 672     672   1571 my ($self, $pattern) = @_;
165              
166 672         1589 my $quote_end = $self->quote_end;
167 672         1663 my $quote_start = $self->quote_start;
168 672         1577 my $start = $self->placeholder_start;
169 672         1628 my $relaxed = $self->relaxed_start;
170 672         1537 my $wildcard = $self->wildcard_start;
171              
172 672         1236 my (@tree, $spec, $more);
173 672         2983 for my $char (split '', $pattern) {
174              
175             # Quoted
176 7165 50 100     44638 if ($char eq $quote_start) { push @tree, ['placeholder', ''] if ++$spec }
  40 100 100     151  
    100 66        
    100 66        
    100 66        
    100 66        
    100 100        
    100          
    100          
    100          
177 40         74 elsif ($char eq $quote_end) { $spec = $more = 0 }
178              
179             # Placeholder
180             elsif (!$more && $char eq $start) {
181 75 100       252 push @tree, ['placeholder', ''] unless $spec++;
182             }
183              
184             # Relaxed or wildcard (upgrade when quoted)
185             elsif (!$more && ($char eq $relaxed || $char eq $wildcard)) {
186 34 100       195 push @tree, ['placeholder', ''] unless $spec++;
187 34 100       137 $tree[-1][2] = $char eq $relaxed ? 'relaxed' : 'wildcard';
188             }
189              
190             # Slash
191             elsif ($char eq '/') {
192 923         2371 push @tree, ['slash'];
193 923         1814 $spec = $more = 0;
194             }
195              
196             # Placeholder
197 795         1352 elsif ($spec && ++$more) { $tree[-1][1] .= $char }
198              
199             # Text (optimize slash+text and *+text+slash+text)
200 4462         7448 elsif ($tree[-1][0] eq 'text') { $tree[-1][-1] .= $char }
201             elsif (!$tree[-2] && $tree[-1][0] eq 'slash') {
202 627         2529 @tree = (['text', "/$char"]);
203             }
204             elsif ($tree[-2] && $tree[-2][0] eq 'text' && $tree[-1][0] eq 'slash') {
205 149 50       496 pop @tree && ($tree[-1][-1] .= "/$char");
206             }
207 20         64 else { push @tree, ['text', $char] }
208             }
209              
210 672         2429 return $self->unparsed($pattern)->tree(\@tree);
211             }
212              
213             1;
214              
215             =encoding utf8
216              
217             =head1 NAME
218              
219             Mojolicious::Routes::Pattern - Route pattern
220              
221             =head1 SYNOPSIS
222              
223             use Mojolicious::Routes::Pattern;
224              
225             # Create pattern
226             my $pattern = Mojolicious::Routes::Pattern->new('/test/:name');
227              
228             # Match routes
229             my $captures = $pattern->match('/test/sebastian');
230             say $captures->{name};
231              
232             =head1 DESCRIPTION
233              
234             L is the core of L.
235              
236             =head1 ATTRIBUTES
237              
238             L implements the following attributes.
239              
240             =head2 constraints
241              
242             my $constraints = $pattern->constraints;
243             $pattern = $pattern->constraints({foo => qr/\w+/});
244              
245             Regular expression constraints.
246              
247             =head2 defaults
248              
249             my $defaults = $pattern->defaults;
250             $pattern = $pattern->defaults({foo => 'bar'});
251              
252             Default parameters.
253              
254             =head2 placeholder_start
255              
256             my $start = $pattern->placeholder_start;
257             $pattern = $pattern->placeholder_start(':');
258              
259             Character indicating a placeholder, defaults to C<:>.
260              
261             =head2 placeholders
262              
263             my $placeholders = $pattern->placeholders;
264             $pattern = $pattern->placeholders(['foo', 'bar']);
265              
266             Placeholder names.
267              
268             =head2 quote_end
269              
270             my $end = $pattern->quote_end;
271             $pattern = $pattern->quote_end('}');
272              
273             Character indicating the end of a quoted placeholder, defaults to C>.
274              
275             =head2 quote_start
276              
277             my $start = $pattern->quote_start;
278             $pattern = $pattern->quote_start('{');
279              
280             Character indicating the start of a quoted placeholder, defaults to C>.
281              
282             =head2 regex
283              
284             my $regex = $pattern->regex;
285             $pattern = $pattern->regex($regex);
286              
287             Pattern in compiled regular expression form.
288              
289             =head2 relaxed_start
290              
291             my $start = $pattern->relaxed_start;
292             $pattern = $pattern->relaxed_start('*');
293              
294             Character indicating a relaxed placeholder, defaults to C<#>.
295              
296             =head2 tree
297              
298             my $tree = $pattern->tree;
299             $pattern = $pattern->tree([['text', '/foo']]);
300              
301             Pattern in parsed form. Note that this structure should only be used very
302             carefully since it is very dynamic.
303              
304             =head2 type_start
305              
306             my $start = $pattern->type_start;
307             $pattern = $pattern->type_start('|');
308              
309             Character indicating the start of a placeholder type, defaults to C<:>.
310              
311             =head2 types
312              
313             my $types = $pattern->types;
314             $pattern = $pattern->types({int => qr/[0-9]+/});
315              
316             Placeholder types.
317              
318             =head2 unparsed
319              
320             my $unparsed = $pattern->unparsed;
321             $pattern = $pattern->unparsed('/:foo/:bar');
322              
323             Raw unparsed pattern.
324              
325             =head2 wildcard_start
326              
327             my $start = $pattern->wildcard_start;
328             $pattern = $pattern->wildcard_start('*');
329              
330             Character indicating the start of a wildcard placeholder, defaults to C<*>.
331              
332             =head1 METHODS
333              
334             L inherits all methods from L and
335             implements the following new ones.
336              
337             =head2 match
338              
339             my $captures = $pattern->match('/foo/bar');
340             my $captures = $pattern->match('/foo/bar', 1);
341              
342             Match pattern against entire path, format detection is disabled by default.
343              
344             =head2 match_partial
345              
346             my $captures = $pattern->match_partial(\$path);
347             my $captures = $pattern->match_partial(\$path, 1);
348              
349             Match pattern against path and remove matching parts, format detection is
350             disabled by default.
351              
352             =head2 new
353              
354             my $pattern = Mojolicious::Routes::Pattern->new;
355             my $pattern = Mojolicious::Routes::Pattern->new('/:action');
356             my $pattern
357             = Mojolicious::Routes::Pattern->new('/:action', action => qr/\w+/);
358             my $pattern = Mojolicious::Routes::Pattern->new(format => 0);
359              
360             Construct a new L object and L pattern
361             if necessary.
362              
363             =head2 parse
364              
365             $pattern = $pattern->parse('/:action');
366             $pattern = $pattern->parse('/:action', action => qr/\w+/);
367             $pattern = $pattern->parse(format => 0);
368              
369             Parse pattern.
370              
371             =head2 render
372              
373             my $path = $pattern->render({action => 'foo'});
374             my $path = $pattern->render({action => 'foo'}, 1);
375              
376             Render pattern into a path with parameters, format rendering is disabled by
377             default.
378              
379             =head1 SEE ALSO
380              
381             L, L, L.
382              
383             =cut