package Mojo::Path; use Mojo::Base -base; use overload '@{}' => sub { shift->parts }, bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1; use Mojo::Util qw(decode encode url_escape url_unescape); has charset => 'UTF-8'; sub new { shift->SUPER::new->parse(@_) } sub canonicalize { my $self = shift; my @parts; for my $part (@{$self->parts}) { # ".." if ($part eq '..') { (@parts && $parts[-1] ne '..') ? pop @parts : push @parts, '..'; } # Something else than "." elsif ($part ne '.' && $part ne '') { push @parts, $part } } $self->trailing_slash(undef) unless @parts; return $self->parts(\@parts); } sub clone { my $self = shift; my $clone = $self->new->charset($self->charset); if (my $parts = $self->{parts}) { $clone->{$_} = $self->{$_} for qw(leading_slash trailing_slash); $clone->{parts} = [@$parts]; } else { $clone->{path} = $self->{path} } return $clone; } sub contains { my ($self, $path) = @_; return $path eq '/' || $self->to_route =~ m!^\Q$path\E(?:/|$)!; } sub leading_slash { shift->_parse(leading_slash => @_) } sub merge { my ($self, $path) = @_; # Replace return $self->parse($path) if $path =~ m!^/!; # Merge pop @{$self->parts} unless $self->trailing_slash; $path = $self->new($path); push @{$self->parts}, @{$path->parts}; return $self->trailing_slash($path->trailing_slash); } sub parse { my $self = shift; $self->{path} = shift; delete @$self{qw(leading_slash parts trailing_slash)}; return $self; } sub parts { shift->_parse(parts => @_) } sub to_abs_string { my $path = shift->to_string; return $path =~ m!^/! ? $path : "/$path"; } sub to_dir { my $clone = shift->clone; pop @{$clone->parts} unless $clone->trailing_slash; return $clone->trailing_slash(!!@{$clone->parts}); } sub to_route { my $clone = shift->clone; my $route = join '/', @{$clone->parts}; return "/$route" . ($clone->trailing_slash ? '/' : ''); } sub to_string { my $self = shift; # Path my $charset = $self->charset; if (defined(my $path = $self->{path})) { $path = encode $charset, $path if $charset; return url_escape $path, '^A-Za-z0-9\-._~!$&\'()*+,;=%:@/'; } # Build path my @parts = @{$self->parts}; @parts = map { encode $charset, $_ } @parts if $charset; my $path = join '/', map { url_escape $_, '^A-Za-z0-9\-._~!$&\'()*+,;=:@' } @parts; $path = "/$path" if $self->leading_slash; $path = "$path/" if $self->trailing_slash; return $path; } sub trailing_slash { shift->_parse(trailing_slash => @_) } sub _parse { my ($self, $name) = (shift, shift); unless ($self->{parts}) { my $path = url_unescape delete($self->{path}) // ''; my $charset = $self->charset; $path = decode($charset, $path) // $path if $charset; $self->{leading_slash} = $path =~ s!^/!!; $self->{trailing_slash} = $path =~ s!/$!!; $self->{parts} = [split '/', $path, -1]; } return $self->{$name} unless @_; $self->{$name} = shift; return $self; } 1; =encoding utf8 =head1 NAME Mojo::Path - Path =head1 SYNOPSIS use Mojo::Path; # Parse my $path = Mojo::Path->new('/foo%2Fbar%3B/baz.html'); say $path->[0]; # Build my $path = Mojo::Path->new('/i/♥'); push @$path, 'mojolicious'; say "$path"; =head1 DESCRIPTION L is a container for paths used by L. =head1 ATTRIBUTES L implements the following attributes. =head2 charset my $charset = $path->charset; $path = $path->charset('UTF-8'); Charset used for encoding and decoding, defaults to C. # Disable encoding and decoding $path->charset(undef); =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 new my $path = Mojo::Path->new; my $path = Mojo::Path->new('/foo%2Fbar%3B/baz.html'); Construct a new L object and L path if necessary. =head2 canonicalize $path = $path->canonicalize; Canonicalize path. # "/foo/baz" Mojo::Path->new('/foo/./bar/../baz')->canonicalize; # "/../baz" Mojo::Path->new('/foo/../bar/../../baz')->canonicalize; =head2 clone my $clone = $path->clone; Clone path. =head2 contains my $bool = $path->contains('/i/♥/mojolicious'); Check if path contains given prefix. # True Mojo::Path->new('/foo/bar')->contains('/'); Mojo::Path->new('/foo/bar')->contains('/foo'); Mojo::Path->new('/foo/bar')->contains('/foo/bar'); # False Mojo::Path->new('/foo/bar')->contains('/f'); Mojo::Path->new('/foo/bar')->contains('/bar'); Mojo::Path->new('/foo/bar')->contains('/whatever'); =head2 leading_slash my $bool = $path->leading_slash; $path = $path->leading_slash($bool); Path has a leading slash. Note that this method will normalize the path and that C<%2F> will be treated as C for security reasons. =head2 merge $path = $path->merge('/foo/bar'); $path = $path->merge('foo/bar'); $path = $path->merge(Mojo::Path->new('foo/bar')); Merge paths. Note that this method will normalize both paths if necessary and that C<%2F> will be treated as C for security reasons. # "/baz/yada" Mojo::Path->new('/foo/bar')->merge('/baz/yada'); # "/foo/baz/yada" Mojo::Path->new('/foo/bar')->merge('baz/yada'); # "/foo/bar/baz/yada" Mojo::Path->new('/foo/bar/')->merge('baz/yada'); =head2 parse $path = $path->parse('/foo%2Fbar%3B/baz.html'); Parse path. =head2 to_abs_string my $str = $path->to_abs_string; Turn path into an absolute string. # "/i/%E2%99%A5/mojolicious" Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_abs_string; Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_abs_string; =head2 parts my $parts = $path->parts; $path = $path->parts([qw(foo bar baz)]); The path parts. Note that this method will normalize the path and that C<%2F> will be treated as C for security reasons. # Part with slash push @{$path->parts}, 'foo/bar'; =head2 to_dir my $dir = $route->to_dir; Clone path and remove everything after the right-most slash. # "/i/%E2%99%A5/" Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_dir->to_abs_string; # "i/%E2%99%A5/" Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_dir->to_abs_string; =head2 to_route my $route = $path->to_route; Turn path into a route. # "/i/♥/mojolicious" Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_route; Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_route; =head2 to_string my $str = $path->to_string; my $str = "$path"; Turn path into a string. # "/i/%E2%99%A5/mojolicious" Mojo::Path->new('/i/%E2%99%A5/mojolicious')->to_string; # "i/%E2%99%A5/mojolicious" Mojo::Path->new('i/%E2%99%A5/mojolicious')->to_string; =head2 trailing_slash my $bool = $path->trailing_slash; $path = $path->trailing_slash($bool); Path has a trailing slash. Note that this method will normalize the path and that C<%2F> will be treated as C for security reasons. =head1 PATH PARTS Direct array reference access to path parts is also possible. Note that this will normalize the path and that C<%2F> will be treated as C for security reasons. say $path->[0]; say for @$path; =head1 SEE ALSO L, L, L. =cut