File Coverage

blib/lib/Mojo/Path.pm
Criterion Covered Total %
statement 82 82 100.0
branch 40 40 100.0
condition 16 17 94.1
subroutine 20 20 100.0
pod 13 13 100.0
total 171 172 99.4


line stmt bran cond sub pod time code
1             package Mojo::Path;
2 62     62   67258 use Mojo::Base -base;
  62         202  
  62         440  
3 62     62   522 use overload '@{}' => sub { shift->parts }, bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
  62     2926   177  
  62     10320   1169  
  3     3295   13  
  17415         37306  
  255         24220  
4              
5 62     62   6678 use Mojo::Util qw(decode encode url_escape url_unescape);
  62         137  
  62         101795  
6              
7             has charset => 'UTF-8';
8              
9             sub canonicalize {
10 920     920 1 1590 my $self = shift;
11              
12 920         2189 my $parts = $self->parts;
13 920         3616 for (my $i = 0; $i <= $#$parts;) {
14 1367 100 100     11634 if (!length $parts->[$i] || $parts->[$i] eq '.' || $parts->[$i] eq '...') { splice @$parts, $i, 1 }
  12 100 100     50  
      100        
      100        
15 1337         3149 elsif ($i < 1 || $parts->[$i] ne '..' || $parts->[$i - 1] eq '..') { $i++ }
16 18         62 else { splice @$parts, --$i, 2 }
17             }
18              
19 920 100       3255 return @$parts ? $self : $self->trailing_slash(undef);
20             }
21              
22             sub clone {
23 2603     2603 1 4145 my $self = shift;
24              
25 2603         5455 my $clone = $self->new;
26 2603 100       7241 if (exists $self->{charset}) { $clone->{charset} = $self->{charset} }
  698         2101  
27 2603 100       5876 if (my $parts = $self->{parts}) {
28 152         759 $clone->{$_} = $self->{$_} for qw(leading_slash trailing_slash);
29 152         448 $clone->{parts} = [@$parts];
30             }
31 2451         6114 else { $clone->{path} = $self->{path} }
32              
33 2603         6046 return $clone;
34             }
35              
36 246 100   246 1 1055 sub contains { $_[1] eq '/' || $_[0]->to_route =~ m!^\Q$_[1]\E(?:/|$)! }
37              
38 1850     1850 1 4315 sub leading_slash { shift->_parse(leading_slash => @_) }
39              
40             sub merge {
41 3810     3810 1 11491 my ($self, $path) = @_;
42              
43             # Replace
44 3810 100       17593 return $self->parse($path) if $path =~ m!^/!;
45              
46             # Merge
47 351 100       1229 pop @{$self->parts} unless $self->trailing_slash;
  335         928  
48 351         1076 $path = $self->new($path);
49 351         692 push @{$self->parts}, @{$path->parts};
  351         974  
  351         770  
50 351         1017 return $self->trailing_slash($path->trailing_slash);
51             }
52              
53 7645 100   7645 1 71724 sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
54              
55             sub parse {
56 4276     4276 1 7296 my $self = shift;
57 4276         10272 $self->{path} = shift;
58 4276         10604 delete @$self{qw(leading_slash parts trailing_slash)};
59 4276         10672 return $self;
60             }
61              
62 7305     7305 1 16259 sub parts { shift->_parse(parts => @_) }
63              
64             sub to_abs_string {
65 821     821 1 2047 my $path = shift->to_string;
66 821 100       4163 return $path =~ m!^/! ? $path : "/$path";
67             }
68              
69             sub to_dir {
70 69     69 1 201 my $clone = shift->clone;
71 69 100       173 pop @{$clone->parts} unless $clone->trailing_slash;
  67         171  
72 69         136 return $clone->trailing_slash(!!@{$clone->parts});
  69         154  
73             }
74              
75             sub to_route {
76 1183     1183 1 3147 my $clone = shift->clone;
77 1183 100       2172 return '/' . join '/', @{$clone->parts}, $clone->trailing_slash ? '' : ();
  1183         2568  
78             }
79              
80             sub to_string {
81 3538     3538 1 5633 my $self = shift;
82              
83             # Path
84 3538         8427 my $charset = $self->charset;
85 3538 100       10154 if (defined(my $path = $self->{path})) {
86 1975 100       7446 $path = encode $charset, $path if $charset;
87 1975         7001 return url_escape $path, '^A-Za-z0-9\-._~!$&\'()*+,;=%:@/';
88             }
89              
90             # Build path
91 1563         2382 my @parts = @{$self->parts};
  1563         3245  
92 1563 100       4393 @parts = map { encode $charset, $_ } @parts if $charset;
  2601         5712  
93 1563         3274 my $path = join '/', map { url_escape $_, '^A-Za-z0-9\-._~!$&\'()*+,;=:@' } @parts;
  2604         5617  
94 1563 100       4696 $path = "/$path" if $self->leading_slash;
95 1563 100       3828 $path = "$path/" if $self->trailing_slash;
96 1563         7187 return $path;
97             }
98              
99 4674     4674 1 10080 sub trailing_slash { shift->_parse(trailing_slash => @_) }
100              
101             sub _parse {
102 13829     13829   24750 my ($self, $name) = (shift, shift);
103              
104 13829 100       30266 unless ($self->{parts}) {
105 4195   100     16860 my $path = url_unescape delete($self->{path}) // '';
106 4195         10709 my $charset = $self->charset;
107 4195 100 66     14079 $path = decode($charset, $path) // $path if $charset;
108 4195         21504 $self->{leading_slash} = $path =~ s!^/!!;
109 4195         11941 $self->{trailing_slash} = $path =~ s!/$!!;
110 4195         16587 $self->{parts} = [split /\//, $path, -1];
111             }
112              
113 13829 100       58969 return $self->{$name} unless @_;
114 1643         3338 $self->{$name} = shift;
115 1643         5039 return $self;
116             }
117              
118             1;
119              
120             =encoding utf8
121              
122             =head1 NAME
123              
124             Mojo::Path - Path
125              
126             =head1 SYNOPSIS
127              
128             use Mojo::Path;
129              
130             # Parse
131             my $path = Mojo::Path->new('/foo%2Fbar%3B/baz.html');
132             say $path->[0];
133              
134             # Build
135             my $path = Mojo::Path->new('/i/♥');
136             push @$path, 'mojolicious';
137             say "$path";
138              
139             =head1 DESCRIPTION
140              
141             L is a container for paths used by L, based on L.
142              
143             =head1 ATTRIBUTES
144              
145             L implements the following attributes.
146              
147             =head2 charset
148              
149             my $charset = $path->charset;
150             $path = $path->charset('UTF-8');
151              
152             Charset used for encoding and decoding, defaults to C.
153              
154             # Disable encoding and decoding
155             $path->charset(undef);
156              
157             =head1 METHODS
158              
159             L inherits all methods from L and implements the following new ones.
160              
161             =head2 canonicalize
162              
163             $path = $path->canonicalize;
164              
165             Canonicalize path by resolving C<.> and C<..>, in addition C<...> will be treated as C<.> to protect from path
166             traversal attacks.
167              
168             # "/foo/baz"
169             Mojo::Path->new('/foo/./bar/../baz')->canonicalize;
170              
171             # "/../baz"
172             Mojo::Path->new('/foo/../bar/../../baz')->canonicalize;
173              
174             # "/foo/bar"
175             Mojo::Path->new('/foo/.../bar')->canonicalize;
176              
177             =head2 clone
178              
179             my $clone = $path->clone;
180              
181             Return a new L object cloned from this path.
182              
183             =head2 contains
184              
185             my $bool = $path->contains('/i/♥/mojolicious');
186              
187             Check if path contains given prefix.
188              
189             # True
190             Mojo::Path->new('/foo/bar')->contains('/');
191             Mojo::Path->new('/foo/bar')->contains('/foo');
192             Mojo::Path->new('/foo/bar')->contains('/foo/bar');
193              
194             # False
195             Mojo::Path->new('/foo/bar')->contains('/f');
196             Mojo::Path->new('/foo/bar')->contains('/bar');
197             Mojo::Path->new('/foo/bar')->contains('/whatever');
198              
199             =head2 leading_slash
200              
201             my $bool = $path->leading_slash;
202             $path = $path->leading_slash($bool);
203              
204             Path has a leading slash. Note that this method will normalize the path and that C<%2F> will be treated as C for
205             security reasons.
206              
207             # "/foo/bar"
208             Mojo::Path->new('foo/bar')->leading_slash(1);
209              
210             # "foo/bar"
211             Mojo::Path->new('/foo/bar')->leading_slash(0);
212              
213             =head2 merge
214              
215             $path = $path->merge('/foo/bar');
216             $path = $path->merge('foo/bar');
217             $path = $path->merge(Mojo::Path->new);
218              
219             Merge paths. Note that this method will normalize both paths if necessary and that C<%2F> will be treated as C for
220             security reasons.
221              
222             # "/baz/yada"
223             Mojo::Path->new('/foo/bar')->merge('/baz/yada');
224              
225             # "/foo/baz/yada"
226             Mojo::Path->new('/foo/bar')->merge('baz/yada');
227              
228             # "/foo/bar/baz/yada"
229             Mojo::Path->new('/foo/bar/')->merge('baz/yada');
230              
231             =head2 new
232              
233             my $path = Mojo::Path->new;
234             my $path = Mojo::Path->new('/foo%2Fbar%3B/baz.html');
235              
236             Construct a new L object and L path if necessary.
237              
238             =head2 parse
239              
240             $path = $path->parse('/foo%2Fbar%3B/baz.html');
241              
242             Parse path.
243              
244             =head2 to_abs_string
245              
246             my $str = $path->to_abs_string;
247              
248             Turn path into an absolute string.
249              
250             # "/i/%E2%99%A5/mojolicious"
251             Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_abs_string;
252             Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_abs_string;
253              
254             =head2 parts
255              
256             my $parts = $path->parts;
257             $path = $path->parts([qw(foo bar baz)]);
258              
259             The path parts. Note that this method will normalize the path and that C<%2F> will be treated as C for security
260             reasons.
261              
262             # Part with slash
263             push @{$path->parts}, 'foo/bar';
264              
265             =head2 to_dir
266              
267             my $dir = $route->to_dir;
268              
269             Clone path and remove everything after the right-most slash.
270              
271             # "/i/%E2%99%A5/"
272             Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_dir->to_abs_string;
273              
274             # "i/%E2%99%A5/"
275             Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_dir->to_abs_string;
276              
277             =head2 to_route
278              
279             my $route = $path->to_route;
280              
281             Turn path into a route.
282              
283             # "/i/♥/mojolicious"
284             Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_route;
285             Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_route;
286              
287             =head2 to_string
288              
289             my $str = $path->to_string;
290              
291             Turn path into a string.
292              
293             # "/i/%E2%99%A5/mojolicious"
294             Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_string;
295              
296             # "i/%E2%99%A5/mojolicious"
297             Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_string;
298              
299             =head2 trailing_slash
300              
301             my $bool = $path->trailing_slash;
302             $path = $path->trailing_slash($bool);
303              
304             Path has a trailing slash. Note that this method will normalize the path and that C<%2F> will be treated as C for
305             security reasons.
306              
307             # "/foo/bar/"
308             Mojo::Path->new('/foo/bar')->trailing_slash(1);
309              
310             # "/foo/bar"
311             Mojo::Path->new('/foo/bar/')->trailing_slash(0);
312              
313             =head1 OPERATORS
314              
315             L overloads the following operators.
316              
317             =head2 array
318              
319             my @parts = @$path;
320              
321             Alias for L. Note that this will normalize the path and that C<%2F> will be treated as C for security
322             reasons.
323              
324             say $path->[0];
325             say for @$path;
326              
327             =head2 bool
328              
329             my $bool = !!$path;
330              
331             Always true.
332              
333             =head2 stringify
334              
335             my $str = "$path";
336              
337             Alias for L.
338              
339             =head1 SEE ALSO
340              
341             L, L, L.
342              
343             =cut