# 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
- 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
__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 {
# 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 {
}
}
+ 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; $_; }
# ->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;
}
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{(?<!/)$}{/};
}
return $self->attributes->{CaptureArgs}[0] || 0;
}
+sub scheme {
+ return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef;
+}
+
sub list_extra_info {
my $self = shift;
return {
A HashRef of key-values that an action can provide to a debugging screen
+=head2 scheme
+
+Any defined scheme for the action
+
=head2 meta
Provided by Moose.
return $captures;
}
+# the scheme defined at the end of the chain is the one we use
+# but warn if too many.
+
+sub scheme {
+ my $self = shift;
+ my @chain = @{ $self->chain };
+ 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;
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
--- /dev/null
+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<Catalyst::Action> 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</http_methods>) 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
push @roles, 'Catalyst::ActionRole::ConsumesContent'
if $args{attributes}->{Consumes};
+ push @roles, 'Catalyst::ActionRole::Scheme'
+ if $args{attributes}->{Scheme};
return @roles;
}
See L<Catalyst::ActionRole::ConsumesContent> 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<https> or that it is a websocket endpoint
+C<ws> or C<wss>. 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<Catalyst::ActionRole::Scheme> for more.
+
=head1 OPTIONAL METHODS
=head2 _parse_[$name]_attr
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}) {
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;
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 )
# 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
--- /dev/null
+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;
projects / catagits/Catalyst-Runtime.git / commitdiff