package Catalyst::Plugin::SmartURI;
$Catalyst::Plugin::SmartURI::VERSION = '0.041';
use Moose;
use mro 'c3';

use 5.008001;
use Class::C3::Componentised;
use Scalar::Util 'weaken';
use Catalyst::Exception ();
use Class::Load ();

use namespace::clean -except => 'meta';

has uri_disposition => (is => 'rw', isa => 'Str');
has uri_class       => (is => 'rw', isa => 'Str');

my $context; # keep a weakend copy for the Request class to use

my ($conf_disposition, $conf_uri_class); # configured values

=head1 NAME

Catalyst::Plugin::SmartURI - Configurable URIs for Catalyst


In your lib/, load the plugin and your other plugins, for example:

    use Catalyst qw/

In your .conf:

        disposition host-header   # application-wide
        uri_class   URI::SmartURI # by default

Per request:


Methods on URIs:

    <a href="[% c.uri_for('/foo').relative %]" ...


Configure whether C<< $c->uri_for >> and C<< $c->req->uri_with >> return absolute, hostless or
relative URIs, or URIs based on the 'Host' header. Also allows configuring which
URI class to use. Works on application-wide or per-request basis.

This is useful in situations where you're for example, redirecting to a lighttpd
from a firewall rule, instead of a real proxy, and you want your links and
redirects to still work correctly.

To use your own URI class, just subclass L<URI::SmartURI> and set
C<uri_class>, or write a class that follows the same interface.

This plugin installs a custom C<< $c->request_class >>, however it does so in a way
that won't break if you've already set C<< $c->request_class >> yourself, ie. by
using L<Catalyst::Action::REST> (thanks mst!).

There is a minor performance penalty in perls older than 5.10, due to
L<Class::C3>, but only at initialization time.

=head1 METHODS

=head2 $c->uri_for

=head2 $c->req->uri_with

Returns a C<< $c->uri_class >> object (L<URI::SmartURI> by default) in the configured
C<< $c->uri_disposition >>.

=head2 $c->req->uri

Returns a C<< $c->uri_class >> object. If the context hasn't been prepared yet, uses
the configured value for C<uri_class>.

C<< $c->req->uri->relative >> will be relative to C<< $c->req->base >>.

=head2 $c->req->referer

Returns a C<< $c->uri_class >> object for the referer (or configured C<uri_class> if
there's no context) with reference set to C<< $c->req->uri >> if it comes from
C<< $c->req->base >>.

In other words, if referer is your app, you can do
C<< $c->req->referer->relative >> and it will do the right thing.


In myapp.conf:

        disposition absolute
        uri_class   URI::SmartURI


=item disposition

One of 'absolute', 'hostless', 'relative' or 'host-header'.  Defaults to

The special disposition 'host-header' uses the value of your 'Host:' header.

=item uri_class

The class to use for URIs, defaults to L<URI::SmartURI>.



    package MyAPP::Controller::RSSFeed;


    sub begin : Private {
        my ($self, $c) = @_;



=item $c->uri_disposition('absolute'|'hostless'|'relative'|'host-header')

Set URI disposition to use for the duration of the request.

=item $c->uri_class($class)

Set the URI class to use for C<< $c->uri_for >> and C<< $c->req->uri_with >> for the
duration of the request.



C<< $c->prepare_uri >> actually creates the URI, which you can override.


sub uri_for {
    my $c = shift;


    package Catalyst::Request::SmartURI;
$Catalyst::Request::SmartURI::VERSION = '0.041';
use Moose;
    extends 'Catalyst::Request';
    use namespace::clean -except => 'meta';

    sub uri_with {
        my $req = shift;


    sub uri {
        my $req = shift;

        my $uri_class = $context ? $context->uri_class : $conf_uri_class;

        my $uri = $req->next::method(@_);

        return $uri if not defined $uri;

                ($req->{base} ? { reference => $req->base } : ())

    sub referer {
        my $req = shift;

        my $uri_class = $context ? $context->uri_class : $conf_uri_class;

        my $referer   = $req->next::method(@_);

        return $referer if not defined $referer;

        my $base      = $req->base;
        my $uri       = $req->uri;

        if ($referer =~ /^$base/) {
            return $uri_class->new($referer, { reference => $uri })
        } else {
            return $uri_class->new($referer);


sub setup {
    my $app    = shift;
    my $config =$app->config->{'Plugin::SmartURI'} || $app->config->{smarturi};

    ($conf_uri_class, $conf_disposition) = @$config{qw/uri_class disposition/};
    $conf_uri_class   ||= 'URI::SmartURI';
    $conf_disposition ||= 'absolute';

    eval { Class::Load::load_class($conf_uri_class) };
        message => "Could not load configured uri_class $conf_uri_class: $@"
    ) if $@;

    my $request_class = $app->request_class;

    unless ($request_class->isa('Catalyst::Request::SmartURI')) {
        my $new_request_class = $app.'::Request::SmartURI';

        my $inject_rest = (not $request_class->isa('Catalyst::Request::REST'))
            && eval { Class::Load::load_class('Catalyst::Request::REST') };

            ($inject_rest ?
                'Catalyst::Request::REST' : ()),



sub prepare_uri {
    my ($c, $uri)   = @_;
    my $disposition = $c->uri_disposition || $conf_disposition;
    my $uri_class   = $c->uri_class       || $conf_uri_class;
# Need the || for $c->welcome_message, otherwise initialization works fine.

    eval { Class::Load::load_class($uri_class) };
        message => "Could not load configured uri_class $uri_class: $@"
    ) if $@;

    my $res;
    if ($disposition eq 'host-header') {
      $res = $uri_class->new($uri, { reference => $c->req->uri })->absolute;
      my $host = $c->req->header('Host');
      my $port = $host =~ s/:(\d+)$// ? $1 : '';

      if ($port) {
          $port = '' if $c->req->uri->scheme eq 'http'  && $port == 80;
          $port = '' if $c->req->uri->scheme eq 'https' && $port == 443;

      $res->port($port) if $port;
    } else {
      $res = $uri_class->new($uri, { reference => $c->req->uri })->$disposition


# Reset accessors to configured values at beginning of request.
sub prepare {
    my $app = shift;

# Also save a copy of the context for the Request class to use.
    my $c = $context = $app->next::method(@_);
    weaken $context;




=head1 SEE ALSO

L<URI::SmartURI>, L<Catalyst>, L<URI>

=head1 AUTHOR

Rafael Kitover, C<< <rkitover at> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-catalyst-plugin-smarturi at>, or through the web
interface at
L<>.  I
will be notified, and then you'll automatically be notified of progress on your
bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Catalyst::Plugin::SmartURI

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker


=item * AnnoCPAN: Annotated CPAN documentation


=item * CPAN Ratings


=item * Search CPAN




from #catalyst:

vipul came up with the idea

mst came up with the design and implementation details for the current version

kd reviewed my code and offered suggestions

=head1 TODO

I'd like to extend on L<Catalyst::Plugin::RequireSSL>, and make a plugin that
rewrites URIs for actions with an SSL attribute.


Copyright (c) 2008 Rafael Kitover

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.


__PACKAGE__; # End of Catalyst::Plugin::SmartURI

# vim: expandtab shiftwidth=4 tw=80: