From: John Napiorkowski Date: Tue, 2 Dec 2014 21:25:00 +0000 (-0600) Subject: finished the scheme matching and uri_for updates X-Git-Tag: 5.90079_001~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=342d21698a97962c51114b6ebc6bb8626511cfc6 finished the scheme matching and uri_for updates --- diff --git a/Changes b/Changes index 066fc25..7c12eb1 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,6 @@ # This file documents the revision history for Perl extension Catalyst. -5.90080_001 - TBD +5.90079_001 - TBD - MyApp->to_app is now an alias for MyApp->psgi_app in order to better support existing Plack conventions. - Modify Catayst::Response->from_psgi_response to allow the first argument to @@ -25,9 +25,14 @@ - Calling $c->res->write($data) now encodes $data based on the configured encoding (UTF-8 is default). - $c->res->writer_fh now returns Catalyst::Response::Writer which is a decorator - over the PSGI writer and provides and additional methd 'write_encoded' that just + over the PSGI writer and provides an additional methd 'write_encoded' that just does the right thing for encoding your responses. This is probably the method you want to use. + - New dispatch matching attribute: Scheme. This lets you match a route based on + the incoming URI scheme (http, https, ws, wss). + - If $c->uri_for targets an action or action chain that defines Scheme, use that + scheme for the generated URI object instead of just using whatever the incoming + request uses. 5.90077 - 2014-11-18 - We store the PSGI $env in Catalyst::Engine for backcompat reasons. Changed diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 9153f82..570abc8 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -129,7 +129,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.90080_001'; +our $VERSION = '5.90079_001'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases sub import { @@ -1374,6 +1374,10 @@ path, use C<< $c->uri_for_action >> instead. # Path to a static resource $c->uri_for('/static/images/logo.png'); +In general the scheme of the generated URI object will follow the incoming request +however if your targeted action or action chain has the Scheme attribute it will +use that instead. + =cut sub uri_for { @@ -1409,6 +1413,7 @@ sub uri_for { } } + my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef; if ( $path->$_isa('Catalyst::Action') ) { # action object s|/|%2F|g for @encoded_args; my $captures = [ map { s|/|%2F|g; $_; } @@ -1420,7 +1425,6 @@ sub uri_for { # ->uri_for( $action, \@captures_and_args, \%query_values? ) if( !@encoded_args && $action->number_of_args ) { my $expanded_action = $c->dispatcher->expand_action( $action ); - my $num_captures = $expanded_action->number_of_captures; unshift @encoded_args, splice @$captures, $num_captures; } @@ -1452,7 +1456,19 @@ sub uri_for { my ($base, $class) = ('/', 'URI::_generic'); if(blessed($c)) { $base = $c->req->base; - $class = ref($base); + if($target_action) { + $target_action = $c->dispatcher->expand_action($target_action); + if(my $s = $target_action->scheme) { + $s = lc($s); + $class = "URI::$s"; + $base->scheme($s); + } else { + $class = ref($base); + } + } else { + $class = ref($base); + } + $base =~ s{(?attributes->{CaptureArgs}[0] || 0; } +sub scheme { + return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef; +} + sub list_extra_info { my $self = shift; return { @@ -192,6 +196,10 @@ Returns the number of captures this action expects for Lchain }; + my ($scheme, @more) = map { + exists $_->attributes->{Scheme} ? $_->attributes->{Scheme}[0] : (); + } reverse @chain; + + warn "$self is a chain with two many Scheme attributes (only one is allowed)" + if @more; + + return $scheme; +} + __PACKAGE__->meta->make_immutable; 1; @@ -87,6 +103,10 @@ Catalyst::ActionChain object representing a chain of these actions Returns the total number of captures for the entire chain of actions. +=head2 scheme + +Any defined scheme for the actionchain + =head2 meta Provided by Moose diff --git a/lib/Catalyst/ActionRole/Scheme.pm b/lib/Catalyst/ActionRole/Scheme.pm new file mode 100644 index 0000000..0f02827 --- /dev/null +++ b/lib/Catalyst/ActionRole/Scheme.pm @@ -0,0 +1,114 @@ +package Catalyst::ActionRole::Scheme; + +use Moose::Role; + +requires 'match', 'match_captures', 'list_extra_info'; + +around ['match','match_captures'] => sub { + my ($orig, $self, $ctx, @args) = @_; + my $request_scheme = lc($ctx->req->env->{'psgi.url_scheme'}); + my $match_scheme = lc($self->scheme||''); + + return $request_scheme eq $match_scheme ? $self->$orig($ctx, @args) : 0; +}; + +around 'list_extra_info' => sub { + my ($orig, $self, @args) = @_; + return { + %{ $self->$orig(@args) }, + Scheme => $self->attributes->{Scheme}[0]||'', + }; +}; + +1; + +=head1 NAME + +Catalyst::ActionRole::ConsumesContent - Match on HTTP Request Content-Type + +=head1 SYNOPSIS + + package MyApp::Web::Controller::MyController; + + use base 'Catalyst::Controller'; + + sub start : POST Chained('/') CaptureArg(0) { ... } + + sub is_json : Chained('start') Consumes('application/json') { ... } + sub is_urlencoded : Chained('start') Consumes('application/x-www-form-urlencoded') { ... } + sub is_multipart : Chained('start') Consumes('multipart/form-data') { ... } + + ## Alternatively, for common types... + + sub is_json : Chained('start') Consume(JSON) { ... } + sub is_urlencoded : Chained('start') Consumes(UrlEncoded) { ... } + sub is_multipart : Chained('start') Consumes(Multipart) { ... } + + ## Or allow more than one type + + sub is_more_than_one + : Chained('start') + : Consumes('application/x-www-form-urlencoded') + : Consumes('multipart/form-data') + { + ## ... + } + + 1; + +=head1 DESCRIPTION + +This is an action role that lets your L match on the content +type of the incoming request. + +Generally when there's a PUT or POST request, there's a request content body +with a matching MIME content type. Commonly this will be one of the types +used with classic HTML forms ('application/x-www-form-urlencoded' for example) +but there's nothing stopping you specifying any valid content type. + +For matching purposes, we match strings but the casing is insensitive. + +=head1 REQUIRES + +This role requires the following methods in the consuming class. + +=head2 match + +=head2 match_captures + +Returns 1 if the action matches the existing request and zero if not. + +=head1 METHODS + +This role defines the following methods + +=head2 match + +=head2 match_captures + +Around method modifier that return 1 if the request content type matches one of the +allowed content types (see L) and zero otherwise. + +=head2 allowed_content_types + +An array of strings that are the allowed content types for matching this action. + +=head2 can_consume + +Boolean. Does the current request match content type with what this actionrole +can consume? + +=head2 list_extra_info + +Add the accepted content type to the debug screen. + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 02db77a..f2ccfa8 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -372,6 +372,8 @@ sub gather_default_action_roles { push @roles, 'Catalyst::ActionRole::ConsumesContent' if $args{attributes}->{Consumes}; + push @roles, 'Catalyst::ActionRole::Scheme' + if $args{attributes}->{Scheme}; return @roles; } @@ -889,6 +891,39 @@ most accurate matches early in the Chain, and your 'catchall' actions last. See L for more. +=head2 Scheme(...) + +Allows you to specify a URI scheme for the action or action chain. For example +you can required that a given path be C or that it is a websocket endpoint +C or C. For an action chain you may currently only have one defined +Scheme. + + package MyApp::Controller::Root; + + use base 'Catalyst::Controller'; + + sub is_http :Path(scheme) Scheme(http) Args(0) { + my ($self, $c) = @_; + $c->response->body("is_http"); + } + + sub is_https :Path(scheme) Scheme(https) Args(0) { + my ($self, $c) = @_; + $c->response->body("is_https"); + } + +In the above example http://localhost/root/scheme would match the first +action (is_http) but https://localhost/root/scheme would match the second. + +As an added benefit, if an action or action chain defines a Scheme, when using +$c->uri_for the scheme of the generated URL will use what you define in the action +or action chain (the current behavior is to set the scheme based on the current +incoming request). This makes it easier to use uri_for on websites where some +paths are secure and others are not. You may also use this to other schemes +like websockets. + +See L for more. + =head1 OPTIONAL METHODS =head2 _parse_[$name]_attr diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 2888607..e29e5b5 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -103,6 +103,7 @@ sub list { my $parent = "DUMMY"; my $extra = $self->_list_extra_http_methods($endpoint); my $consumes = $self->_list_extra_consumes($endpoint); + my $scheme = $self->_list_extra_scheme($endpoint); my $curr = $endpoint; while ($curr) { if (my $cap = $curr->list_extra_info->{CaptureArgs}) { @@ -134,13 +135,16 @@ sub list { if (defined(my $ct = $p->list_extra_info->{Consumes})) { $name .= ' :'.$ct; } + if (defined(my $s = $p->list_extra_info->{Scheme})) { + $scheme = uc $s; + } unless ($p eq $parents[0]) { $name = "-> ${name}"; } push(@rows, [ '', $name ]); } - push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]); + push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : ''). ($scheme ? "$scheme: ":'')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]); my @display_parts = map { $_ =~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; decode_utf8 $_ } @parts; $rows[0][0] = join('/', '', @display_parts) || '/'; $paths->row(@$_) for @rows; @@ -164,6 +168,11 @@ sub _list_extra_consumes { return join(', ', @{$action->list_extra_info->{CONSUMES}}); } +sub _list_extra_scheme { + my ( $self, $action ) = @_; + return unless defined $action->list_extra_info->{Scheme}; + return uc $action->list_extra_info->{Scheme}; +} =head2 $self->match( $c, $path ) diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm index e12e2e0..d2b1eb8 100644 --- a/lib/Catalyst/Runtime.pm +++ b/lib/Catalyst/Runtime.pm @@ -7,7 +7,7 @@ BEGIN { require 5.008003; } # Remember to update this in Catalyst as well! -our $VERSION = '5.90080_001'; +our $VERSION = '5.90079_001'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases =head1 NAME diff --git a/t/dispatch_on_scheme.t b/t/dispatch_on_scheme.t new file mode 100644 index 0000000..1da72a2 --- /dev/null +++ b/t/dispatch_on_scheme.t @@ -0,0 +1,123 @@ +use warnings; +use strict; +use Test::More; +use HTTP::Request::Common; + +# Test cases for dispatching on URI Scheme + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + sub is_http :Path(scheme) Scheme(http) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'http'; + $c->response->body("is_http"); + } + + sub is_https :Path(scheme) Scheme(https) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'https'; + $c->response->body("is_https"); + } + + sub base :Chained('/') CaptureArgs(0) { } + + sub is_http_chain :GET Chained('base') PathPart(scheme) Scheme(http) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'http'; + $c->response->body("base/is_http"); + } + + sub is_https_chain :Chained('base') PathPart(scheme) Scheme(https) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'https'; + $c->response->body("base/is_https"); + } + + sub uri_for1 :Chained('base') Scheme(https) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'https'; + $c->response->body($c->uri_for($c->action)->as_string); + } + + sub uri_for2 :Chained('base') Scheme(https) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'https'; + $c->response->body($c->uri_for($self->action_for('is_http'))->as_string); + } + + sub uri_for3 :Chained('base') Scheme(http) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'http'; + $c->response->body($c->uri_for($self->action_for('endpoint'))->as_string); + } + + sub base2 :Chained('/') CaptureArgs(0) { } + sub link :Chained(base2) Scheme(https) CaptureArgs(0) { } + sub endpoint :Chained(link) Args(0) { + my ($self, $c) = @_; + Test::More::is $c->action->scheme, 'https'; + $c->response->body("end"); + } + + + package MyApp; + use Catalyst; + + Test::More::ok(MyApp->setup, 'setup app'); +} + +use Catalyst::Test 'MyApp'; + +{ + my $res = request "/root/scheme"; + is $res->code, 200, 'OK'; + is $res->content, 'is_http', 'correct body'; +} + +{ + my $res = request "https://localhost/root/scheme"; + is $res->code, 200, 'OK'; + is $res->content, 'is_https', 'correct body'; +} + +{ + my $res = request "/base/scheme"; + is $res->code, 200, 'OK'; + is $res->content, 'base/is_http', 'correct body'; +} + +{ + my $res = request "https://localhost/base/scheme"; + is $res->code, 200, 'OK'; + is $res->content, 'base/is_https', 'correct body'; +} + +{ + my $res = request "https://localhost/base/uri_for1"; + is $res->code, 200, 'OK'; + is $res->content, 'https://localhost/base/uri_for1', 'correct body'; +} + +{ + my $res = request "https://localhost/base/uri_for2"; + is $res->code, 200, 'OK'; + is $res->content, 'http://localhost/root/scheme', 'correct body'; +} + +{ + my $res = request "/base/uri_for3"; + is $res->code, 200, 'OK'; + is $res->content, 'https://localhost/base2/link/endpoint', 'correct body'; +} + +{ + my $res = request "https://localhost/base2/link/endpoint"; + is $res->code, 200, 'OK'; + is $res->content, 'end', 'correct body'; +} + +done_testing;