# Copyright (C) 2008-2009, Sebastian Riedel. package Mojo::Path; use strict; use warnings; use base 'Mojo::Base'; use overload '""' => sub { shift->to_string }, fallback => 1; use Mojo::ByteStream; use Mojo::URL; __PACKAGE__->attr( [qw/leading_slash trailing_slash/] => ( chained => 1, default => 0 ) ); __PACKAGE__->attr(parts => (chained => 1, default => sub { [] })); sub new { my $self = shift->SUPER::new(); $self->parse(@_); return $self; } sub append { my $self = shift; for (@_) { my $value = "$_"; # *( pchar / "/" / "?" ) $value = Mojo::ByteStream->new($value)->url_escape($Mojo::URL::PCHAR) ->to_string; push @{$self->parts}, $value; } return $self; } sub canonicalize { my $self = shift; # Resolve path my @path; for my $part (@{$self->parts}) { # ".." if ($part eq '..') { # Leading '..' can't be resolved unless (@path && $path[-1] ne '..') { push @path, '..' } # Uplevel else { pop @path } next; } # "." next if $part eq '.'; # Part push @path, $part; } $self->parts(\@path); return $self; } # Homer, the plant called. # They said if you don't show up tomorrow don't bother showing up on Monday. # Woo-hoo. Four-day weekend. sub clone { my $self = shift; my $clone = Mojo::Path->new; $clone->parts([@{$self->parts}]); $clone->leading_slash($self->leading_slash); $clone->trailing_slash($self->trailing_slash); return $clone; } sub parse { my ($self, $path) = @_; $path ||= ''; # Meta $self->leading_slash(1) if $path =~ /^\//; $self->trailing_slash(1) if $path =~ /\/$/; # Parse my @parts; for my $part (split '/', $path) { # Garbage next unless $part; # Store push @parts, $part; } $self->parts(\@parts); return $self; } sub to_string { my $self = shift; # Escape my @path; for my $part (@{$self->parts}) { # *( pchar / "/" / "?" ) push @path, Mojo::ByteStream->new($part)->url_escape($Mojo::URL::PCHAR) ->to_string; } # Format my $path = join '/', @path; $path = "/$path" if $self->leading_slash; $path = "$path/" if @path && $self->trailing_slash; return $path; } 1; __END__ =head1 NAME Mojo::Path - Path =head1 SYNOPSIS use Mojo::Path; my $path = Mojo::Path->new('/foo/bar%3B/baz.html'); print "$path"; =head1 DESCRIPTION L is a container for URL paths. =head1 ATTRIBUTES =head2 C my $leading_slash = $path->leading_slash; $path = $path->leading_slash(1); =head2 C my $parts = $path->parts; $path = $path->parts(qw/foo bar baz/); =head2 C my $trailing_slash = $path->trailing_slash; $path = $path->trailing_slash(1); =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 C my $path = Mojo::Path->new; my $path = Mojo::Path->new('/foo/bar%3B/baz.html'); =head2 C $path = $path->append(qw/foo bar/); =head2 C $path = $path->canonicalize; =head2 C my $clone = $path->clone; =head2 C $path = $path->parse('/foo/bar%3B/baz.html'); =head2 C my $string = $path->to_string; =cut