# This file documents the revision history for Perl extension Catalyst.
+5.90089_001 - TBA
+ - New Feature: Type Constraints on Args/CapturArgs. ALlows you to declare
+ a Moose, MooseX::Types or Type::Tiny named constraint on your Arg or
+ CaptureArg.
+ - New top level document on Route matching. (Catalyst::RouteMatching).
+
5.90085 - 2015-03-25
- Small change to Catalyst::Action to prevent autovivication of Args value (dim1++)
- Minor typo fixes (Abraxxa++)
__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90085';
+our $VERSION = '5.90089_001';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub import {
use Moose;
use Scalar::Util 'looks_like_number';
+use Moose::Util::TypeConstraints ();
with 'MooseX::Emulate::Class::Accessor::Fast';
use namespace::clean -except => 'meta';
default => sub { '/'.shift->reverse },
);
+has number_of_args => (
+ is=>'ro',
+ init_arg=>undef,
+ isa=>'Int|Undef',
+ required=>1,
+ lazy=>1,
+ builder=>'_build_number_of_args');
+
+ sub _build_number_of_args {
+ my $self = shift;
+ if( ! exists $self->attributes->{Args} ) {
+ # When 'Args' does not exist, that means we want 'any number of args'.
+ return undef;
+ } elsif(!defined($self->attributes->{Args}[0])) {
+ # When its 'Args' that internal cue for 'unlimited'
+ return undef;
+ } elsif(
+ scalar(@{$self->attributes->{Args}}) == 1 &&
+ looks_like_number($self->attributes->{Args}[0])
+ ) {
+ # 'Old school' numbered args (is allowed to be undef as well)
+ return $self->attributes->{Args}[0];
+ } else {
+ # New hotness named arg constraints
+ return $self->number_of_args_constraints;
+ }
+ }
+
+sub normalized_arg_number {
+ return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
+}
+
+has number_of_args_constraints => (
+ is=>'ro',
+ isa=>'Int|Undef',
+ init_arg=>undef,
+ required=>1,
+ lazy=>1,
+ builder=>'_build_number_of_args_constraints');
+
+ sub _build_number_of_args_constraints {
+ my $self = shift;
+ return unless $self->has_args_constraints;
+
+ my $total = 0;
+ foreach my $tc( @{$self->args_constraints}) {
+ if($tc->is_a_type_of('Ref')) {
+ if($tc->can('parameters') && $tc->has_parameters) {
+ my $total_params = scalar(@{ $tc->parameters||[] });
+ $total = $total + $total_params;
+ } else {
+ # Its a Reftype but we don't know the number of params it
+ # actually validates.
+ return undef;
+ }
+ } else {
+ $total++;
+ }
+ }
+
+ return $total;
+ }
+
+has args_constraints => (
+ is=>'ro',
+ init_arg=>undef,
+ traits=>['Array'],
+ isa=>'ArrayRef',
+ required=>1,
+ lazy=>1,
+ builder=>'_build_args_constraints',
+ handles => {
+ has_args_constraints => 'count',
+ args_constraint_count => 'count',
+ });
+
+ sub _build_args_constraints {
+ my $self = shift;
+ my @arg_protos = @{$self->attributes->{Args}||[]};
+
+ return [] unless scalar(@arg_protos);
+ return [] unless defined($arg_protos[0]);
+
+ # If there is only one arg and it looks like a number
+ # we assume its 'classic' and the number is the number of
+ # constraints.
+ my @args = ();
+ if(
+ scalar(@arg_protos) == 1 &&
+ looks_like_number($arg_protos[0])
+ ) {
+ return \@args;
+ } else {
+ @args =
+ map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
+ @arg_protos;
+ }
+ return \@args;
+ }
+
+has number_of_captures_constraints => (
+ is=>'ro',
+ isa=>'Int|Undef',
+ init_arg=>undef,
+ required=>1,
+ lazy=>1,
+ builder=>'_build_number_of_capture_constraints');
+
+ sub _build_number_of_capture_constraints {
+ my $self = shift;
+ return unless $self->has_captures_constraints;
+
+ my $total = 0;
+ foreach my $tc( @{$self->captures_constraints}) {
+ if($tc->is_a_type_of('Ref')) {
+ if($tc->can('parameters') && $tc->has_parameters) {
+ my $total_params = scalar(@{ $tc->parameters||[] });
+ $total = $total + $total_params;
+ } else {
+ # Its a Reftype but we don't know the number of params it
+ # actually validates. This is not currently permitted in
+ # a capture...
+ die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters";
+ }
+ } else {
+ $total++;
+ }
+ }
+
+ return $total;
+ }
+
+has captures_constraints => (
+ is=>'ro',
+ init_arg=>undef,
+ traits=>['Array'],
+ isa=>'ArrayRef',
+ required=>1,
+ lazy=>1,
+ builder=>'_build_captures_constraints',
+ handles => {
+ has_captures_constraints => 'count',
+ captures_constraints_count => 'count',
+ });
+
+ sub _build_captures_constraints {
+ my $self = shift;
+ my @arg_protos = @{$self->attributes->{CaptureArgs}||[]};
+
+ return [] unless scalar(@arg_protos);
+ return [] unless defined($arg_protos[0]);
+ # If there is only one arg and it looks like a number
+ # we assume its 'classic' and the number is the number of
+ # constraints.
+ my @args = ();
+ if(
+ scalar(@arg_protos) == 1 &&
+ looks_like_number($arg_protos[0])
+ ) {
+ return \@args;
+ } else {
+ @args =
+ map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" }
+ @arg_protos;
+ }
+
+ return \@args;
+ }
+
+sub resolve_type_constraint {
+ my ($self, $name) = @_;
+ my @tc = eval "package ${\$self->class}; $name";
+ return @tc if $tc[0];
+ return Moose::Util::TypeConstraints::find_or_parse_type_constraint($name);
+}
+
+has number_of_captures => (
+ is=>'ro',
+ init_arg=>undef,
+ isa=>'Int',
+ required=>1,
+ lazy=>1,
+ builder=>'_build_number_of_captures');
+
+ sub _build_number_of_captures {
+ my $self = shift;
+ if( ! exists $self->attributes->{CaptureArgs} ) {
+ # If there are no defined capture args, thats considered 0.
+ return 0;
+ } elsif(!defined($self->attributes->{CaptureArgs}[0])) {
+ # If you fail to give a defined value, that's also 0
+ return 0;
+ } elsif(
+ scalar(@{$self->attributes->{CaptureArgs}}) == 1 &&
+ looks_like_number($self->attributes->{CaptureArgs}[0])
+ ) {
+ # 'Old school' numbered captures
+ return $self->attributes->{CaptureArgs}[0];
+ } else {
+ # New hotness named arg constraints
+ return $self->number_of_captures_constraints;
+ }
+ }
+
+
use overload (
# Stringify to reverse for debug output etc.
);
-
-
no warnings 'recursion';
sub dispatch { # Execute ourselves against a context
sub match {
my ( $self, $c ) = @_;
- #would it be unreasonable to store the number of arguments
- #the action has as its own attribute?
- #it would basically eliminate the code below. ehhh. small fish
- return 1 unless exists $self->attributes->{Args};
- my $args = $self->attributes->{Args}[0];
- return 1 unless defined($args) && length($args);
- return scalar( @{ $c->req->args } ) == $args;
-}
-
-sub match_captures { 1 }
-sub compare {
- my ($a1, $a2) = @_;
-
- my ($a1_args) = @{ $a1->attributes->{Args} || [] };
- my ($a2_args) = @{ $a2->attributes->{Args} || [] };
-
- $_ = looks_like_number($_) ? $_ : ~0
- for $a1_args, $a2_args;
-
- return $a1_args <=> $a2_args;
+ warn $self->reverse;
+
+ # If infinite args, we always match
+ return 1 if $self->normalized_arg_number == ~0;
+
+ # There there are arg constraints, we must see to it that the constraints
+ # check positive for each arg in the list.
+ if($self->has_args_constraints) {
+ # If there is only one type constraint, and its a Ref or subtype of Ref,
+ # That means we expect a reference, so use the full args arrayref.
+ if(
+ $self->args_constraint_count == 1 &&
+ (
+ $self->args_constraints->[0]->is_a_type_of('Ref') ||
+ $self->args_constraints->[0]->is_a_type_of('ClassName')
+ )
+ ) {
+ return $self->args_constraints->[0]->check($c->req->args);
+ # Removing coercion stuff for the first go
+ #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) {
+ # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0;
+ # $c->req->args([$coerced]);
+ # return 1;
+ #}
+ } else {
+ # Because of the way chaining works, we can expect args that are totally not
+ # what you'd expect length wise. When they don't match length, thats a fail
+ return 0 unless scalar( @{ $c->req->args } ) == $self->normalized_arg_number;
+
+ for my $i(0..$#{ $c->req->args }) {
+ $self->args_constraints->[$i]->check($c->req->args->[$i]) || return 0;
+ }
+ return 1;
+ }
+ } else {
+ # Otherwise, we just need to match the number of args.
+ return scalar( @{ $c->req->args } ) == $self->normalized_arg_number;
+ }
}
-sub number_of_args {
- my ( $self ) = @_;
- return 0 unless exists $self->attributes->{Args};
- return $self->attributes->{Args}[0];
+sub match_captures {
+ my ($self, $c, $captures) = @_;
+ my @captures = @{$captures||[]};
+
+ return 1 unless scalar(@captures); # If none, just say its ok
+
+ if($self->has_captures_constraints) {
+ if(
+ $self->captures_constraints_count == 1 &&
+ (
+ $self->captures_constraints->[0]->is_a_type_of('Ref') ||
+ $self->captures_constraints->[0]->is_a_type_of('ClassName')
+ )
+ ) {
+ return $self->captures_constraints->[0]->check($captures);
+ } else {
+ for my $i(0..$#captures) {
+ $self->captures_constraints->[$i]->check($captures[$i]) || return 0;
+ }
+ return 1;
+ }
+ } else {
+ return 1;
+ }
+ return 1;
}
-sub number_of_captures {
- my ( $self ) = @_;
-
- return 0 unless exists $self->attributes->{CaptureArgs};
- return $self->attributes->{CaptureArgs}[0] || 0;
+sub compare {
+ my ($a1, $a2) = @_;
+ return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
}
sub scheme {
sub list_extra_info {
my $self = shift;
return {
- Args => exists $self->attributes->{Args} ? $self->attributes->{Args}[0] : undef,
+ Args => $self->normalized_arg_number,
CaptureArgs => $self->number_of_captures,
}
}
Returning true from this method causes the chain match to continue, returning
makes the chain not match (and alternate, less preferred chains will be attempted).
+=head2 resolve_type_constraint
+
+Trys to find a type constraint if you have on on a type constrained method.
=head2 compare
=head2 number_of_args
-Returns the number of args this action expects. This is 0 if the action doesn't take any arguments and undef if it will take any number of arguments.
+Returns the number of args this action expects. This is 0 if the action doesn't
+take any arguments and undef if it will take any number of arguments.
+
+=head2 normalized_arg_number
+
+For the purposes of comparison we normalize 'number_of_args' so that if it is
+undef we mean ~0 (as many args are we can think of).
=head2 number_of_captures
the same terms as Perl itself.
=cut
+
+
requires 'match', 'match_captures', 'list_extra_info';
-around ['match','match_captures'] => sub {
- my ($orig, $self, $ctx, @args) = @_;
- my $expected = $ctx->req->method;
- return $self->_has_expected_http_method($expected) ?
- $self->$orig($ctx, @args) :
- 0;
-};
-
+sub allowed_http_methods { @{shift->attributes->{Method}||[]} }
sub _has_expected_http_method {
my ($self, $expected) = @_;
1 : 0;
}
-sub allowed_http_methods { @{shift->attributes->{Method}||[]} }
+around ['match','match_captures'] => sub {
+ my ($orig, $self, $ctx, @args) = @_;
+ return 0 unless $self->$orig($ctx, @args);
+
+ my $expected = $ctx->req->method;
+ warn $expected;
+ return $self->_has_expected_http_method($expected);
+};
around 'list_extra_info' => sub {
my ($orig, $self, @args) = @_;
=head2 CaptureArgs
-Please see L<Catalyst::DispatchType::Chained>
+Allowed values for CaptureArgs is a single integer (CaptureArgs(2), meaning two
+allowed) or you can declare a L<Moose>, L<MooseX::Types> or L<Type::Tiny>
+named constraint such as CaptureArgs(Int,Str) would require two args with
+the first being a Integer and the second a string. You may declare your own
+custom type constraints and import them into the controller namespace:
+
+ package MyApp::Controller::Root;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+ use MyApp::Types qw/Int/;
+
+ extends 'Catalyst::Controller';
+
+ sub chain_base :Chained(/) CaptureArgs(1) { }
+
+ sub any_priority_chain :Chained(chain_base) PathPart('') Args(1) { }
+
+ sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { }
+
+See L<Catalyst::RouteMatching> for more.
+
+Please see L<Catalyst::DispatchType::Chained> for more.
=head2 ActionClass
the path. However if no Args value is set, assumed to 'slurp' all
remaining path pars under this namespace.
+Allowed values for Args is a single integer (Args(2), meaning two allowed) or you
+can declare a L<Moose>, L<MooseX::Types> or L<Type::Tiny> named constraint such
+as Args(Int,Str) would require two args with the first being a Integer and the
+second a string. You may declare your own custom type constraints and import
+them into the controller namespace:
+
+ package MyApp::Controller::Root;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+ use MyApp::Types qw/Tuple Int Str StrMatch UserId/;
+
+ extends 'Catalyst::Controller';
+
+ sub user :Local Args(UserId) {
+ my ($self, $c, $int) = @_;
+ }
+
+ sub an_int :Local Args(Int) {
+ my ($self, $c, $int) = @_;
+ }
+
+ sub many_ints :Local Args(ArrayRef[Int]) {
+ my ($self, $c, @ints) = @_;
+ }
+
+ sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
+ my ($self, $c, $int) = @_;
+ }
+
+See L<Catalyst::RouteMatching> for more.
+
=head2 Consumes('...')
Matches the current action against the content-type of the request. Typically
@{ $self->_endpoints }
) {
my $args = $endpoint->list_extra_info->{Args};
- my @parts = (defined($args) ? (("*") x $args) : '...');
+ my @parts = (defined($endpoint->attributes->{Args}[0]) ? (("*") x $args) : '...');
my @parents = ();
my $parent = "DUMMY";
my $extra = $self->_list_extra_http_methods($endpoint);
$name = "${extra} ${name}";
}
if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) {
- $name .= ' ('.$cap.')';
+ if($p->has_captures_constraints) {
+ my $tc = join ',', @{$p->captures_constraints};
+ $name .= " ($tc)";
+ } else {
+ $name .= " ($cap)";
+ }
}
if (defined(my $ct = $p->list_extra_info->{Consumes})) {
$name .= ' :'.$ct;
}
push(@rows, [ '', $name ]);
}
+
+ if($endpoint->has_args_constraints) {
+ my $tc = join ',', @{$endpoint->args_constraints};
+ $endpoint .= " ($tc)";
+ } else {
+ $endpoint .= defined($endpoint->attributes->{Args}[0]) ? " ($args)" : " (...)";
+ }
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) || '/';
my @try_actions = @{$children->{$try_part}};
TRY_ACTION: foreach my $action (@try_actions) {
if (my $capture_attr = $action->attributes->{CaptureArgs}) {
- my $capture_count = $capture_attr->[0] || 0;
+ my $capture_count = $action->number_of_captures|| 0;
# Short-circuit if not enough remaining parts
next TRY_ACTION unless @parts >= $capture_count;
push(@captures, splice(@parts, 0, $capture_count));
# check if the action may fit, depending on a given test by the app
- if ($action->can('match_captures')) { next TRY_ACTION unless $action->match_captures($c, \@captures) }
+ next TRY_ACTION unless $action->match_captures($c, \@captures);
# try the remaining parts against children of this action
my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match(
=cut
-sub _check_args_attr {
- my ( $self, $action, $name ) = @_;
-
- return unless exists $action->attributes->{$name};
-
- if (@{$action->attributes->{$name}} > 1) {
- Catalyst::Exception->throw(
- "Multiple $name attributes not supported registering " . $action->reverse()
- );
- }
- my $args = $action->attributes->{$name}->[0];
- if (defined($args) and not (
- Scalar::Util::looks_like_number($args) and
- int($args) == $args and $args >= 0
- )) {
- require Data::Dumper;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Indent = 0;
- $args = Data::Dumper::Dumper($args);
- Catalyst::Exception->throw(
- "Invalid $name($args) for action " . $action->reverse() .
- " (use '$name' or '$name(<number>)')"
- );
- }
-}
-
sub register {
my ( $self, $c, $action ) = @_;
$self->_actions->{'/'.$action->reverse} = $action;
- foreach my $name (qw(Args CaptureArgs)) {
- $self->_check_args_attr($action, $name);
- }
-
if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) {
Catalyst::Exception->throw(
"Combining Args and CaptureArgs attributes not supported registering " .
my @captures = @$captures;
my $parent = "DUMMY";
my $curr = $action;
+ # If this is an action chain get the last action in the chain
+ if($curr->can('chain') ) {
+ $curr = ${$curr->chain}[-1];
+ }
while ($curr) {
- if (my $cap = $curr->attributes->{CaptureArgs}) {
- return undef unless @captures >= ($cap->[0]||0); # not enough captures
- if ($cap->[0]) {
- unshift(@parts, splice(@captures, -$cap->[0]));
+ if (my $cap = $curr->number_of_captures) {
+ return undef unless @captures >= $cap; # not enough captures
+ if ($cap) {
+ unshift(@parts, splice(@captures, -$cap));
}
}
if (my $pp = $curr->attributes->{PathPart}) {
attribute) but has no C<:CaptureArgs> attribute is treated by Catalyst
as a chain end.
+Allowed values for CaptureArgs is a single integer (CaptureArgs(2), meaning two
+allowed) or you can declare a L<Moose>, L<MooseX::Types> or L<Type::Tiny>
+named constraint such as CaptureArgs(Int,Str) would require two args with
+the first being a Integer and the second a string. You may declare your own
+custom type constraints and import them into the controller namespace:
+
+ package MyApp::Controller::Root;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+ use MyApp::Types qw/Int/;
+
+ extends 'Catalyst::Controller';
+
+ sub chain_base :Chained(/) CaptureArgs(1) { }
+
+ sub any_priority_chain :Chained(chain_base) PathPart('') Args(1) { }
+
+ sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { }
+
+See L<Catalyst::RouteMatching> for more.
+
=item Args
By default, endpoints receive the rest of the arguments in the path. You
);
foreach my $path ( sort keys %{ $self->_paths } ) {
foreach my $action ( @{ $self->_paths->{$path} } ) {
- my $args = $action->attributes->{Args}->[0];
+ my $args = $action->number_of_args;
my $parts = defined($args) ? '/*' x $args : '/...';
my $display_path = "/$path/$parts";
--- /dev/null
+=encoding UTF-8
+
+=head1 Name
+
+Catalyst::RouteMatching - How Catalyst maps an incoming URL to actions in controllers.
+
+=head1 Description
+
+This is a WIP document intended to help people understand the logic that L<Catalyst>
+uses to determine how to match in incoming request to an action (or action chain)
+in a controller.
+
+=head2 Type Constraints in Args and Capture Args
+
+Beginning in Version 5.90090+ you may use L<Moose>, L<MooseX::Types> or L<Type::Tiny>
+type constraints to futher declare allowed matching for Args or CaptureArgs. Here
+is a simple example:
+
+ package MyApp::Controller::User;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+
+ extends 'Catalyst::Controller';
+
+ sub find :Path('') Args(Int) {
+ my ($self, $c, $int) = @_;
+ }
+
+ __PACKAGE__->meta->make_immutable;
+
+In this case the incoming request "http://localhost:/user/100" would match the action
+C<find> but "http://localhost:/user/not_a_number" would not. You may find declaring
+constraints in this manner aids with debugging, automatic generation of documentation
+and reducing the amount of manual checking you might need to do in your actions. For
+example if the argument in the given action was going to be used to lookup a row
+in a database, if the matching field expected an integer, a string might cause a database
+exception, prompting you to add additional checking of the argument prior to using it.
+In general it is hoped this feature can lead to reduced validation boilerplate and more
+easily understood and declarative actions.
+
+More than one argument may be added by comma separating your type constraint names, for
+example:
+
+ sub find :Path('') Args(Int,Int,Str) {
+ my ($self, $c, $int1, $int2, $str) = @_;
+ }
+
+Would require three arguments, an integer, integer and a string.
+
+=head3 Using type constraints in a controller
+
+By default L<Catalyst> allows all the standard, built-in, named type constraints that come
+bundled with L<Moose>. However it is trivial to create your own Type constraint libraries
+and export them to a controller that wishes to use them. We recommend using L<Type::Tiny> or
+L<MooseX::Types> for this. Here is an example using some extended type constraints via
+the L<Types::Standard> library that is packaged with L<Type::Tiny>:
+
+ package MyApp::Controller::User;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+ use Types::Standard qw/StrMatch/;
+
+ extends 'Catalyst::Controller';
+
+ sub looks_like_a_date :Path('') Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
+ my ($self, $c, $int) = @_;
+ }
+
+ __PACKAGE__->meta->make_immutable;
+
+This would match URLs like "http://localhost/user/11-11-2015" for example. If you've been
+missing the old RegExp matching, this can emulate a good chunk of that ability, and more.
+
+A tutorial on how to make custom type libraries is outside the scope of this document. I'd
+recommend looking at the copious documentation in L<Type::Tiny> or in L<MooseX::Types> if
+you prefer that system. The author recommends L<Type::Tiny> if you are unsure which to use.
+
+=head3 Match order when more than one Action matches a path.
+
+As previously described, L<Catalyst> will match 'the longest path', which generally means
+that named path / path_parts will take precidence over Args or CaptureArgs. However, what
+will happen if two actions match the same path with equal args? For example:
+
+ sub an_int :Path(user) Args(Int) {
+ }
+
+ sub an_any :Path(user) Args(1) {
+ }
+
+In this case L<Catalyst> will check actions starting from the LAST one defined. Generally
+this means you should put your most specific action rules LAST and your 'catch-alls' first.
+In the above example, since Args(1) will match any argument, you will find that that 'an_int'
+action NEVER gets hit. You would need to reverse the order:
+
+ sub an_any :Path(user) Args(1) {
+ }
+
+ sub an_int :Path(user) Args(Int) {
+ }
+
+Now requests that match this path would first hit the 'an_int' action and will check to see if
+the argument is an integer. If it is, then the action will execute, otherwise it will pass and
+the dispatcher will check the next matching action (in this case we fall thru to the 'an_any'
+action).
+
+=head3 Type Constraints and Chained Actions
+
+Using type constraints in Chained actions works the same as it does for Path and Local or Global
+actions. The only difference is that you may declare type constraints on CaptureArgs as
+well as Args. For Example:
+
+ sub chain_base :Chained(/) CaptureArgs(1) { }
+
+ sub any_priority_chain :Chained(chain_base) PathPart('') Args(1) { }
+
+ sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { }
+
+ sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
+
+ sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { }
+
+ sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { }
+
+ sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
+
+ sub any_priority_link :Chained(link_int) PathPart('') Args(1) { }
+
+ sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { }
+
+These chained actions migth create match tables like the following:
+
+ [debug] Loaded Chained actions:
+ .----------------------------------------------+----------------------------------------------.
+ | Path Spec | Private |
+ +----------------------------------------------+----------------------------------------------+
+ | /chain_base/*/* | /chain_base (1) |
+ | | => /any_priority_chain |
+ | /chain_base/*/*/* | /chain_base (1) |
+ | | -> /link_int (1) |
+ | | => /any_priority_link |
+ | /chain_base/*/*/* | /chain_base (1) |
+ | | -> /link_any (1) |
+ | | => /any_priority_link_any |
+ | /chain_base/*/* | /chain_base (1) |
+ | | => /int_priority_chain |
+ | /chain_base/*/*/* | /chain_base (1) |
+ | | -> /link_int (1) |
+ | | => /int_priority_link |
+ | /chain_base/*/*/* | /chain_base (1) |
+ | | -> /link_any (1) |
+ | | => /int_priority_link_any |
+ '----------------------------------------------+----------------------------------------------'
+
+As you can see the same general path could be matched by various action chains. In this case
+the rule described in the previous section should be followed, which is that L<Catalyst>
+will start with the last defined action and work upward. For example the action C<int_priority_chain>
+would be checked before C<any_priority_chain>. The same applies for actions that are midway links
+in a longer chain. In this case C<link_int> would be checked before C<link_any>. So as always we
+recommend that you place you priority or most constrainted actions last and you least or catch-all
+actions first.
+
+Although this reverse order checking may seen counter intuitive it does have the added benefit that
+when inheriting controllers any new actions added would take check precedence over those in your
+parent controller or consumed role.
+
+=head1 Conclusion
+
+ TBD
+
+=head1 Author
+
+John Napiorkowski L<jjnapiork@cpan.org|email:jjnapiork@cpan.org>
+
+=cut
+
-package Catalyst::Runtime;
use strict;
use warnings;
# Remember to update this in Catalyst as well!
-our $VERSION = '5.90085';
+our $VERSION = '5.90089_001';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
=head1 NAME
--- /dev/null
+use warnings;
+use strict;
+use HTTP::Request::Common;
+
+BEGIN {
+ use Test::More;
+ eval "use Types::Standard; use Type::Utils; use Type::Library; 1;" || do {
+ plan skip_all => "Trouble loading Types::Standard => $@";
+ };
+
+ package MyApp::Types;
+ $INC{'MyApp/Types.pm'} = __FILE__;
+
+ use strict;
+ use warnings;
+
+ use Type::Utils -all;
+ use Types::Standard -types;
+ use Type::Library
+ -base,
+ -declare => qw( UserId User ContextLike );
+
+ extends "Types::Standard";
+
+ class_type User, { class => "MyApp::Model::User::user" };
+ duck_type ContextLike, [qw/model/];
+
+ declare UserId,
+ as Int,
+ where { $_ < 5 };
+
+ # Tests using this are skipped pending deeper thought
+ coerce User,
+ from ContextLike,
+ via { $_->model('User')->find( $_->req->args->[0] ) };
+}
+
+{
+ package MyApp::Model::User;
+ $INC{'MyApp/Model/User.pm'} = __FILE__;
+
+ use base 'Catalyst::Model';
+
+ our %users = (
+ 1 => { name => 'john', age => 46 },
+ 2 => { name => 'mary', age => 36 },
+ 3 => { name => 'ian', age => 25 },
+ 4 => { name => 'visha', age => 18 },
+ );
+
+ sub find {
+ my ($self, $id) = @_;
+ my $user = $users{$id} || return;
+ return bless $user, "MyApp::Model::User::user";
+ }
+
+ package MyApp::Controller::Root;
+ $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+ use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User/;
+
+ extends 'Catalyst::Controller';
+
+ sub user :Local Args(UserId) {
+ my ($self, $c, $int) = @_;
+ my $user = $c->model("User")->find($int);
+ $c->res->body("name: $user->{name}, age: $user->{age}");
+ }
+
+ # Tests using this are current skipped pending coercion rethink
+ sub user_object :Local Args(User) Coerce(1) {
+ my ($self, $c, $user) = @_;
+ $c->res->body("name: $user->{name}, age: $user->{age}");
+ }
+
+ sub an_int :Local Args(Int) {
+ my ($self, $c, $int) = @_;
+ $c->res->body('an_int');
+ }
+
+ sub two_ints :Local Args(Int,Int) {
+ my ($self, $c, $int) = @_;
+ $c->res->body('two_ints');
+ }
+
+ sub many_ints :Local Args(ArrayRef[Int]) {
+ my ($self, $c, $int) = @_;
+ $c->res->body('many_ints');
+ }
+
+ sub tuple :Local Args(Tuple[Str,Int]) {
+ my ($self, $c, $str, $int) = @_;
+ $c->res->body('tuple');
+ }
+
+ sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
+ my ($self, $c, $int) = @_;
+ $c->res->body('match');
+ }
+
+ sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') }
+
+ sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') }
+
+ sub chain_base :Chained(/) CaptureArgs(1) { }
+
+ sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }
+
+ sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }
+
+ sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
+
+ sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
+
+ sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
+
+ sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
+
+ sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
+
+ sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }
+
+ sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }
+
+ sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }
+
+ sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }
+
+ sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }
+
+ sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }
+
+ sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }
+
+ sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }
+
+ sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
+ sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }
+
+ sub chain_base2 :Chained(/) CaptureArgs(1) { }
+
+ sub chained_zero_again : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_again') }
+ sub chained_zero_post2 : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post2') }
+ sub chained_zero2 : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero2') }
+
+ sub chained_zero_post3 : Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero_post3') }
+ sub chained_zero3 : Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero3') }
+
+
+ sub default :Default {
+ my ($self, $c, $int) = @_;
+ $c->res->body('default');
+ }
+
+ MyApp::Controller::Root->config(namespace=>'');
+
+ package MyApp;
+ use Catalyst;
+
+ MyApp->setup;
+}
+
+use Catalyst::Test 'MyApp';
+
+{
+ my $res = request '/an_int/1';
+ is $res->content, 'an_int';
+}
+
+{
+ my $res = request '/an_int/aa';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/many_ints/1';
+ is $res->content, 'many_ints';
+}
+
+{
+ my $res = request '/many_ints/1/2';
+ is $res->content, 'many_ints';
+}
+
+{
+ my $res = request '/many_ints/1/2/3';
+ is $res->content, 'many_ints';
+}
+
+{
+ my $res = request '/priority_test/1';
+ is $res->content, 'int_priority';
+}
+
+{
+ my $res = request '/priority_test/a';
+ is $res->content, 'any_priority';
+}
+
+{
+ my $res = request '/match/11-22-33';
+ is $res->content, 'match';
+}
+
+{
+ my $res = request '/match/aaa';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/user/2';
+ is $res->content, 'name: mary, age: 36';
+}
+
+{
+ my $res = request '/user/20';
+ is $res->content, 'default';
+}
+
+
+SKIP: {
+ skip "coercion support needs more thought", 1;
+ my $res = request '/user_object/20';
+ is $res->content, 'default';
+}
+
+SKIP: {
+ skip "coercion support needs more thought", 1;
+ my $res = request '/user_object/2';
+ is $res->content, 'name: mary, age: 36';
+}
+
+{
+ my $res = request '/chain_base/capture/arg';
+ is $res->content, 'any_priority_chain';
+}
+
+{
+ my $res = request '/chain_base/cap1/100/arg';
+ is $res->content, 'any_priority_link';
+}
+
+{
+ my $res = request '/chain_base/cap1/101/102';
+ is $res->content, 'int_priority_link';
+}
+
+{
+ my $res = request '/chain_base/capture/100';
+ is $res->content, 'int_priority_chain', 'got expected';
+}
+
+{
+ my $res = request '/chain_base/cap1/a/arg';
+ is $res->content, 'any_priority_link_any';
+}
+
+{
+ my $res = request '/chain_base/cap1/a/102';
+ is $res->content, 'int_priority_link_any';
+}
+
+{
+ my $res = request '/two_ints/1/2';
+ is $res->content, 'two_ints';
+}
+
+{
+ my $res = request '/two_ints/aa/111';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/tuple/aaa/aaa';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/tuple/aaa/111';
+ is $res->content, 'tuple';
+}
+
+{
+ my $res = request '/many_ints/1/2/a';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/chain_base/100/100/100/100';
+ is $res->content, 'int_priority_link2';
+}
+
+{
+ my $res = request '/chain_base/100/ss/100/100';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/chain_base/100/100/100/100/100';
+ is $res->content, 'int_priority_link3';
+}
+
+{
+ my $res = request '/chain_base/100/ss/100/100/100';
+ is $res->content, 'default';
+}
+
+{
+ my $res = request '/chain_base/1/2/3/3/3/6';
+ is $res->content, 'finally';
+}
+
+{
+ my $res = request '/chain_base/1/2/3/3/3/a';
+ is $res->content, 'finally2';
+}
+
+{
+ my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
+ is $res->content, 'finally2';
+}
+
+
+{
+ my $res = request PUT '/chain_base2/capture/1';
+ is $res->content, 'chained_zero3', "request PUT '/chain_base2/capture/1'";
+}
+
+{
+ my $res = request '/chain_base2/capture/1';
+ is $res->content, 'chained_zero3', "request '/chain_base2/capture/1'";
+}
+
+{
+ my $res = request POST '/chain_base2/capture/1';
+ is $res->content, 'chained_zero3', "request POST '/chain_base2/capture/1'";
+}
+
+{
+ my $res = request PUT '/chain_base2/capture';
+ is $res->content, 'chained_zero2', "request PUT '/chain_base2/capture'";
+}
+
+{
+ my $res = request '/chain_base2/capture';
+ is $res->content, 'chained_zero2', "request '/chain_base2/capture'";
+}
+
+{
+ my $res = request POST '/chain_base2/capture';
+ is $res->content, 'chained_zero2', "request POST '/chain_base2/capture'";
+}
+
+=over
+
+| /chain_base/*/*/*/*/*/* | /chain_base (1)
+| | -> /link_tuple (Tuple[Int,Int,Int])
+| | -> /link2_int (UserId)
+| | => GET /finally (Int)
+
+=cut
+
+
+done_testing;
+
+__END__
+{
+ # URI testing
+ my ($res, $c) = ctx_request '/';
+ ok my $url1 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5],6);
+ warn $url1;
+
+ ok my $url2 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]);
+ warn $url2;
+}
+
use Test::More;
+# This test needs to be rewritten (and the code it was using as well) since
+# when we added the arg and capturearg type constraint support, we now allow
+# non integer values. however we could probably support some additional sanity
+# testing on the values, so this is a nice TODO for someone -jnap
+
+plan skip_all => 'Removing this test because constraint arg types allow this';
+
use Catalyst::Test 'TestApp';
for my $fail (
$SIG{__WARN__} = sub {
my $error = shift;
- Test::More::like($error, qr[You called ->params with an undefined value at t.undef-params.t])
+ Test::More::like($error, qr[You called ->params with an undefined value])
unless MyApp->debug;
};
projects / catagits/Catalyst-Runtime.git / commitdiff