[Catalyst-commits] r8082 - in Catalyst-Plugin-SmartURI/1.000/trunk:
. lib/Catalyst/Plugin t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Fri Jul 4 05:19:44 BST 2008
Author: caelum
Date: 2008-07-04 05:19:44 +0100 (Fri, 04 Jul 2008)
New Revision: 8082
Modified:
Catalyst-Plugin-SmartURI/1.000/trunk/META.yml
Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL
Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm
Catalyst-Plugin-SmartURI/1.000/trunk/t/01-basic.t
Catalyst-Plugin-SmartURI/1.000/trunk/t/02-c-a-rest-compat.t
Log:
SmartURI: better req class, better tests and Host-header parsing
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/META.yml
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/META.yml 2008-07-04 02:37:30 UTC (rev 8081)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/META.yml 2008-07-04 04:19:44 UTC (rev 8082)
@@ -19,8 +19,7 @@
Catalyst: 5.7007
Class::Accessor::Fast: 0
Class::C3::Componentised: 0
- Class::Data::Inheritable: 0
Task::Weaken: 0
URI::SmartURI: 0
parent: 0
-version: 0.025
+version: 0.026
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL 2008-07-04 02:37:30 UTC (rev 8081)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL 2008-07-04 04:19:44 UTC (rev 8082)
@@ -7,7 +7,6 @@
requires 'Catalyst' => '5.7007';
requires 'Class::C3::Componentised';
requires 'Class::Accessor::Fast';
-requires 'Class::Data::Inheritable';
requires 'URI::SmartURI';
requires 'Task::Weaken';
requires 'parent';
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm 2008-07-04 02:37:30 UTC (rev 8081)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm 2008-07-04 04:19:44 UTC (rev 8082)
@@ -2,34 +2,38 @@
use strict;
use warnings;
-use parent qw/Class::Accessor::Fast Class::Data::Inheritable/;
+use parent 'Class::Accessor::Fast';
use Class::C3;
use Class::C3::Componentised;
use Scalar::Util 'weaken';
+use Catalyst::Exception ();
__PACKAGE__->mk_accessors(qw/uri_disposition uri_class/);
my $context; # keep a 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 VERSION
-Version 0.024
+Version 0.026
=cut
-our $VERSION = '0.025';
+our $VERSION = '0.026';
=head1 SYNOPSIS
In your .conf:
<Plugin::SmartURI>
- disposition host-header # application-wide
+ disposition host-header # application-wide
+ uri_class URI::SmartURI # by default
</Plugin::SmartURI>
Per request:
@@ -40,30 +44,40 @@
<a href="[% c.uri_for('/foo').relative %]" ...
+=head1 DESCRIPTION
+
Configure whether $c->uri_for and $c->req->uri_with return absolute, hostless or
-relative URIs and/or configure which URI class to use, on an application or
-request basis.
+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.
-=head1 DESCRIPTION
-
-This plugin allows you to configure, on a application and per-request basis,
-what URI class $c->uri_for and $c->req->uri_with use, as well as whether the
-URIs they produce are absolute, hostless or relative.
-
To use your own URI class, just subclass L<URI::SmartURI> and set
uri_class, or write a class that follows the same interface.
This plugin installs a custom $c->request_class, however it does so in a way
-that won't break if you've already set $c->request_class yourself (thanks mst!).
+that won't break if you've already set $c->request_class yourself, ie. by using
+L<Catalyst::Action::REST> (thanks mst!).
-There will be a slight performance penalty for your first few requests, due to
-the way L<URI::SmartURI> works, but after that you shouldn't notice
-it. The penalty is considerably smaller in perl 5.10+.
+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->uri_class object (L<URI::SmartURI> by default) in the configured
+$c->uri_disposition.
+
+=head2 $c->req->uri
+=head2 $c->req->referer
+
+Returns a $c->uri_class object. If the context hasn't been prepared yet, uses
+the configured value for uri_class.
+
=head1 CONFIGURATION
In myapp.conf:
@@ -116,8 +130,7 @@
=head1 EXTENDING
-$c->prepare_uri actually creates the URI, you can overload that to do as you
-please in your own plugins.
+$c->prepare_uri actually creates the URI, which you can override.
=cut
@@ -136,15 +149,42 @@
$context->prepare_uri($req->next::method(@_))
}
+
+ sub uri {
+ my $req = shift;
+
+ my $uri_class = $context ? $context->uri_class : $conf_uri_class;
+
+ $uri_class->new(
+ $req->next::method(@_),
+ { reference => $req->base }
+ )
+ }
+
+ sub referer {
+ my $req = shift;
+
+ my $uri_class = $context ? $context->uri_class : $conf_uri_class;
+
+ $uri_class->new($req->next::method(@_))
+ }
}
sub setup {
my $app = shift;
my $config =$app->config->{'Plugin::SmartURI'} || $app->config->{smarturi};
- $config->{uri_class} ||= 'URI::SmartURI';
- $config->{disposition} ||= 'absolute';
+ ($conf_uri_class, $conf_disposition) = @$config{qw/uri_class disposition/};
+ $conf_uri_class ||= 'URI::SmartURI';
+ $conf_disposition ||= 'absolute';
+ unless (do { no strict 'refs'; %{$conf_uri_class.'::'} }) {
+ eval "require $conf_uri_class";
+ Catalyst::Exception->throw(
+ message => "Could not load configured uri_class $conf_uri_class: $@"
+ ) if $@;
+ }
+
my $request_class = $app->request_class;
unless ($request_class->isa('Catalyst::Request::SmartURI')) {
@@ -167,19 +207,33 @@
sub prepare_uri {
my ($c, $uri) = @_;
- my $disposition = $c->uri_disposition || 'absolute';
- my $uri_class = $c->uri_class || 'URI::SmartURI';
+ 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 "require $uri_class",$loaded{$uri_class}++ unless $loaded{$uri_class};
+ unless ($loaded{$uri_class} || do { no strict 'refs'; %{$uri_class.'::'} }) {
+ eval "require $uri_class";
+ if ($@) {
+ Catalyst::Exception->throw(
+ message => "Could not load configured uri_class $conf_uri_class: $@"
+ );
+ } else {
+ $loaded{$uri_class}++
+ }
+ }
my $res;
if ($disposition eq 'host-header') {
$res = $uri_class->new($uri, { reference => $c->req->uri })->absolute;
my $host = $c->req->header('Host');
$host =~ s/:(\d+)$//;
+
+ my $port = $1;
+ $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($1) if $1;
+ $res->port($port) if $port;
} else {
$res = $uri_class->new($uri, { reference => $c->req->uri })->$disposition
}
@@ -190,15 +244,14 @@
# Reset accessors to configured values at beginning of request.
sub prepare {
- my $app = shift;
- my $config =$app->config->{'Plugin::SmartURI'} || $app->config->{smarturi};
+ 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($config->{uri_class});
- $c->uri_disposition($config->{disposition});
+ $c->uri_class($conf_uri_class);
+ $c->uri_disposition($conf_disposition);
$c
}
@@ -274,4 +327,4 @@
1; # End of Catalyst::Plugin::SmartURI
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
+# vim: expandtab shiftwidth=4 tw=80:
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/t/01-basic.t
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/t/01-basic.t 2008-07-04 02:37:30 UTC (rev 8081)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/t/01-basic.t 2008-07-04 04:19:44 UTC (rev 8082)
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 8;
{
package TestApp;
@@ -34,7 +34,6 @@
sub host_header : Global {
my ($self, $c) = @_;
- $c->req->header(Host => 'www.dongs.com');
$c->uri_disposition('host-header');
$c->res->output($c->uri_for('/dummy'));
}
@@ -42,11 +41,20 @@
sub host_header_with_port : Global {
my ($self, $c) = @_;
- $c->req->header(Host => 'www.hlagh.com:8080');
$c->uri_disposition('host-header');
$c->res->output($c->uri_for('/dummy'));
}
+ sub req_uri_class : Global {
+ my ($self, $c) = @_;
+ $c->res->output(ref($c->req->uri).' '.$c->req->uri);
+ }
+
+ sub req_referer_class : Global {
+ my ($self, $c) = @_;
+ $c->res->output(ref $c->req->referer);
+ }
+
sub dummy : Global {}
__PACKAGE__->config->{'Plugin::SmartURI'}{disposition} = 'hostless';
@@ -54,6 +62,7 @@
}
use Catalyst::Test 'TestApp';
+use HTTP::Request;
is(request('/test_uri_for_redirect')->header('location'),
'/test_uri_for_redirect', 'redirect location');
@@ -67,10 +76,20 @@
is(get('/test_uri_object'), '/test_uri_object',
'URI objects are functional');
-is(get('/host_header'), 'http://www.dongs.com/dummy',
+my $req = HTTP::Request->new(GET => '/host_header');
+$req->header(Host => 'www.dongs.com');
+is(request($req)->content, 'http://www.dongs.com/dummy',
'host-header disposition');
-is(get('/host_header_with_port'), 'http://www.hlagh.com:8080/dummy',
+$req = HTTP::Request->new(GET => '/host_header_with_port');
+$req->header(Host => 'www.hlagh.com:8080');
+is(request($req)->content, 'http://www.hlagh.com:8080/dummy',
'host-header disposition with port');
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
+is(get('/req_uri_class'), 'URI::SmartURI::http http://localhost/req_uri_class',
+ 'overridden $c->req->uri');
+
+like(get('/req_referer_class'), qr/^URI::SmartURI::/,
+ 'overridden $c->req->referer');
+
+# vim: expandtab shiftwidth=4 tw=80:
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/t/02-c-a-rest-compat.t
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/t/02-c-a-rest-compat.t 2008-07-04 02:37:30 UTC (rev 8081)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/t/02-c-a-rest-compat.t 2008-07-04 04:19:44 UTC (rev 8082)
@@ -6,7 +6,8 @@
SKIP: {
-skip 'Catalyst::Action::REST not installed', 1 if eval 'use Catalyst::Action::REST', $@;
+skip 'Catalyst::Action::REST not installed', 1
+ if eval { require Catalyst::Action::REST }, $@;
{
package TestApp;
More information about the Catalyst-commits
mailing list