On Friday 10 October 2008 02:04:44 pm Andrew Rodland wrote:
> On Friday 10 October 2008 01:21:14 pm Jason Kuri wrote:
> > Great work. I was looking into this yesterday. I'm glad you beat me
> > to it. :-)
> >
> > To follow up on Tomas' comment - Why not make the override_base_uri /
> > override_base_uri_secure include the schema? So if you want the URI's
> > to include https:// even if the request is coming in not-secure, you
> > can do that.
> >
> > Without this functionality it would be hard to do SSL accelerators and
> > such properly.
>
> I was trying to be clever and make it so that you only needed one config
> key in the case where your secure and nonsecure bases only differed in the
> scheme. I guess it was too clever. I'll go back and make them entirely
> separate -- it'll be less code anyway. :)
New version based on input from t0m and jayk and karpet.
lib/Catalyst/Engine/CGI.pm | 23 +++++++--
t/unit_engine_cgi.t | 86 +++++++++++++++++++++++++++++++++++
2 files changed, 105 insertions(+), 4 deletions(-)
Andrew
Index: t/unit_engine_cgi.t
===================================================================
--- t/unit_engine_cgi.t (revision 0)
+++ t/unit_engine_cgi.t (revision 0)
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use URI;
+
+use_ok('Catalyst');
+
+my $http_request = Catalyst::Request->new( { secure => 0 } );
+my $https_request = Catalyst::Request->new( { secure => 1 } );
+
+$ENV{HTTP_HOST} = "127.0.0.1";
+$ENV{SERVER_PORT} = 80;
+$ENV{SCRIPT_NAME} = '/catalyst.fcgi';
+
+my $context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'http://127.0.0.1/catalyst.fcgi/pants',
+ 'Base URI'
+);
+
+$context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "http://127.1.2.3/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'http://127.1.2.3/pants',
+ 'Overriden base URI'
+);
+
+$context = Catalyst->new( {
+ request => $https_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri_secure} = "https://127.1.2.3/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'https://127.1.2.3/pants',
+ 'Overriden base URI for HTTPS'
+);
+
+$context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "https://127.1.2.3/";;
+$context->setup_engine('CGI');
+$context->prepare_path;
+
+is (
+ Catalyst::uri_for( $context, '/pants' )->as_string,
+ 'https://127.1.2.3/pants',
+ 'Override nonsecure base URI to HTTPS'
+);
+
+$context = Catalyst->new( {
+ request => $http_request,
+ namespace => 'yada',
+ } );
+$context->config->{override_base_uri} = "dev.catalyst.perl.org";
+$context->setup_engine('CGI');
+eval {
+ $context->prepare_path;
+};
+
+like (
+ $@,
+ qr/Invalid/,
+ 'Handle invalid override_base_uri'
+);
+
Index: lib/Catalyst/Engine/CGI.pm
===================================================================
--- lib/Catalyst/Engine/CGI.pm (revision 8518)
+++ lib/Catalyst/Engine/CGI.pm (working copy)
@@ -160,12 +160,27 @@
$c->request->uri( bless \$uri, $uri_class );
# set the base URI
+
+ my $base_uri;
+
+ if (defined $c->config->{override_base_uri} && ! $c->request->secure) {
+ # Use an overridden base URI.
+ $base_uri = $c->config->{override_base_uri};
+ } elsif (defined $c->config->{override_base_uri_secure} && $c->request->secure) {
+ # For HTTPS requests.
+ $base_uri = $c->config->{override_base_uri_secure};
+ } else {
+ # Use the server-provided (default) base path.
+ $base_uri = $scheme . '://' . $host . $base_path;
+ }
+
# base must end in a slash
- $base_path .= '/' unless $base_path =~ m{/$};
+ $base_uri .= '/' unless $base_uri =~ m{/$};
+ # Ref. URI.pm
+ $base_uri =~ /^([A-Za-z][A-Za-z0-9.+-]*):/ or die "Invalid base URI";
+ my $base_scheme = $1;
- my $base_uri = $scheme . '://' . $host . $base_path;
-
- $c->request->base( bless \$base_uri, $uri_class );
+ $c->request->base( bless \$base_uri, "URI::$base_scheme" );
}
=head2 $self->prepare_query_parameters($c)
_______________________________________________
List: Catalyst@lists.scsys.co.uk
Listinfo: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
Searchable archive: http://www.mail-archive.com/catalyst@lists.scsys.co.uk/
Dev site: http://dev.catalyst.perl.org/
