view release on metacpan or  search on metacpan

lib/Catalyst/Plugin/SmartURI.pm  view on Meta::CPAN

package Catalyst::Plugin::SmartURI;
our $AUTHORITY = 'cpan:RKITOVER';
$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

=head1 SYNOPSIS

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

    use Catalyst qw/
        -Debug
        ConfigLoader
        Static::Simple
        Session
        Session::Store::Memcached
        Session::State::Cookie
        Authentication
        Authorization::Roles
        +CatalystX::SimpleLogin
        SmartURI
    /;

In your .conf:

    <Plugin::SmartURI>
        disposition host-header   # application-wide
        uri_class   URI::SmartURI # by default
    </Plugin::SmartURI>

Per request:

    $c->uri_disposition('absolute');

Methods on URIs:

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

=head1 DESCRIPTION

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

lib/Catalyst/Plugin/SmartURI.pm  view on Meta::CPAN

    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') };

        Class::C3::Componentised->inject_base(
            $new_request_class,
            'Catalyst::Request::SmartURI',
            ($inject_rest ?
                'Catalyst::Request::REST' : ()),
            $request_class,
        );
        Class::C3::reinitialize();

        $app->request_class($new_request_class);
    }

    $app->next::method(@_)
}

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) };
    Catalyst::Exception->throw(
        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->host($host);
      $res->port($port) if $port;
    } else {
      $res = $uri_class->new($uri, { reference => $c->req->uri })->$disposition
    }

    $res
}

# 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;

    $c->uri_class($conf_uri_class);
    $c->uri_disposition($conf_disposition);

    $c
}

__PACKAGE__->meta->make_immutable;

=head1 SEE ALSO

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

=head1 AUTHOR

Rafael Kitover, C<< <rkitover at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-catalyst-plugin-smarturi at rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-SmartURI>.  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

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-SmartURI>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Catalyst-Plugin-SmartURI>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Catalyst-Plugin-SmartURI>

=item * Search CPAN

L<http://search.cpan.org/dist/Catalyst-Plugin-SmartURI>

=back

=head1 ACKNOWLEDGEMENTS

from #catalyst:

vipul came up with the idea