package Template::Flute::UriAdjust; use strict; use warnings; use URI; use URI::Escape; use URI::Escape (qw/uri_unescape/); use Moo; =head1 NAME Template::Flute::UriAdjust - URI adjust class for Template::Flute =head1 SYNOPSIS $new_path = Template::Flute::UriAdjust->new( uri => 'test', adjust => '/t/', ); =head1 DESCRIPTION Adjusts relative URIs to a base path. =head1 ATTRIBUTES =head2 adjust Base path. =cut has adjust => ( is => 'rw', required => 1, ); =head2 uri URI to be adjusted. =cut has uri => ( is => 'rw', required => 1, ); =head2 scheme URI scheme (defaults to C). =cut has scheme => ( is => 'rw', default => 'http', ); =head1 METHODS =head2 result Returns new URI if it has adjusted. Otherwise it returns undef. =cut sub result { my ($self) = @_; my $uri = URI->new($self->uri); # set scheme if necessary if (! $uri->scheme) { $uri->scheme($self->scheme); } my $result = $uri->clone; if (! $uri->host) { # add prefix to link my $adjust = $self->adjust; if ($uri->path =~ m%^/%) { $adjust =~ s%/$%%; } elsif ($adjust !~ m%/$%) { $adjust .= '/'; } $result->path($adjust . $uri->path); # unescape the resulting path $result = uri_unescape($result->path); if ($uri->fragment) { $result .= "#" . uri_unescape($uri->fragment); } return $result; } return; }; =head1 AUTHOR Stefan Hornburg (Racke), =head1 LICENSE AND COPYRIGHT Copyright 2014 Stefan Hornburg (Racke) . This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut 1;