Merge r9534 renaming kanes crequest to ctx_request up from 5.70 trunk. 5.80 is now...
[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Chained.pm
CommitLineData
5882c86e 1package Catalyst::DispatchType::Chained;
141459fa 2
3c0186f2 3use Moose;
e8b9f2a9 4extends 'Catalyst::DispatchType';
5
141459fa 6use Text::SimpleTable;
7use Catalyst::ActionChain;
39fc2ce1 8use Catalyst::Utils;
141459fa 9use URI;
10
be5cb4e4 11has _endpoints => (
12 is => 'rw',
13 isa => 'ArrayRef',
14 required => 1,
15 default => sub{ [] },
16 );
17
18has _actions => (
19 is => 'rw',
20 isa => 'HashRef',
21 required => 1,
22 default => sub{ {} },
23 );
24
25has _children_of => (
26 is => 'rw',
27 isa => 'HashRef',
28 required => 1,
29 default => sub{ {} },
30 );
31
0fc2d522 32no Moose;
33
792b40ac 34# please don't perltidy this. hairy code within.
35
141459fa 36=head1 NAME
37
5882c86e 38Catalyst::DispatchType::Chained - Path Part DispatchType
141459fa 39
40=head1 SYNOPSIS
41
05a90578 42 # root action - captures one argument after it
43 sub foo_setup : Chained('/') PathPart('foo') CaptureArgs(1) {
44 my ( $self, $c, $foo_arg ) = @_;
45 ...
46 }
47
48 # child action endpoint - takes one argument
49 sub bar : Chained('foo_setup') Args(1) {
50 my ( $self, $c, $bar_arg ) = @_;
51 ...
52 }
141459fa 53
54=head1 DESCRIPTION
55
05a90578 56See L</USAGE>.
57
141459fa 58=head1 METHODS
59
60=head2 $self->list($c)
61
62Debug output for Path Part dispatch points
63
141459fa 64=cut
65
792b40ac 66sub list {
67 my ( $self, $c ) = @_;
68
be5cb4e4 69 return unless $self->_endpoints;
792b40ac 70
39fc2ce1 71 my $column_width = Catalyst::Utils::term_width() - 35 - 9;
792b40ac 72 my $paths = Text::SimpleTable->new(
3b9c0812 73 [ 35, 'Path Spec' ], [ $column_width, 'Private' ],
39fc2ce1 74 );
792b40ac 75
007a7ca0 76 my $has_unattached_actions;
77 my $unattached_actions = Text::SimpleTable->new(
78 [ 35, 'Private' ], [ 36, 'Missing parent' ],
79 );
80
792b40ac 81 ENDPOINT: foreach my $endpoint (
82 sort { $a->reverse cmp $b->reverse }
be5cb4e4 83 @{ $self->_endpoints }
792b40ac 84 ) {
85 my $args = $endpoint->attributes->{Args}->[0];
86 my @parts = (defined($args) ? (("*") x $args) : '...');
d34667c3 87 my @parents = ();
792b40ac 88 my $parent = "DUMMY";
89 my $curr = $endpoint;
90 while ($curr) {
1c34f703 91 if (my $cap = $curr->attributes->{CaptureArgs}) {
792b40ac 92 unshift(@parts, (("*") x $cap->[0]));
93 }
94 if (my $pp = $curr->attributes->{PartPath}) {
95 unshift(@parts, $pp->[0])
96 if (defined $pp->[0] && length $pp->[0]);
97 }
5882c86e 98 $parent = $curr->attributes->{Chained}->[0];
be5cb4e4 99 $curr = $self->_actions->{$parent};
d34667c3 100 unshift(@parents, $curr) if $curr;
792b40ac 101 }
007a7ca0 102 if ($parent ne '/') {
103 $has_unattached_actions = 1;
104 $unattached_actions->row('/'.$parents[0]->reverse, $parent);
105 next ENDPOINT;
106 }
d34667c3 107 my @rows;
108 foreach my $p (@parents) {
109 my $name = "/${p}";
1c34f703 110 if (my $cap = $p->attributes->{CaptureArgs}) {
d34667c3 111 $name .= ' ('.$cap->[0].')';
112 }
113 unless ($p eq $parents[0]) {
114 $name = "-> ${name}";
115 }
116 push(@rows, [ '', $name ]);
117 }
118 push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]);
119 $rows[0][0] = join('/', '', @parts);
120 $paths->row(@$_) for @rows;
792b40ac 121 }
122
1cf0345b 123 $c->log->debug( "Loaded Chained actions:\n" . $paths->draw . "\n" );
007a7ca0 124 $c->log->debug( "Unattached Chained actions:\n", $unattached_actions->draw . "\n" )
125 if $has_unattached_actions;
792b40ac 126}
141459fa 127
128=head2 $self->match( $c, $path )
129
05a90578 130Calls C<recurse_match> to see if a chain matches the C<$path>.
141459fa 131
132=cut
133
134sub match {
135 my ( $self, $c, $path ) = @_;
136
e5ecd5bc 137 my $request = $c->request;
138 return 0 if @{$request->args};
141459fa 139
140 my @parts = split('/', $path);
141
6365b527 142 my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts);
e5ecd5bc 143 push @{$request->args}, @$parts if $parts && @$parts;
141459fa 144
145 return 0 unless $chain;
146
147 my $action = Catalyst::ActionChain->from_chain($chain);
148
e5ecd5bc 149 $request->action("/${action}");
150 $request->match("/${action}");
151 $request->captures($captures);
141459fa 152 $c->action($action);
153 $c->namespace( $action->namespace );
154
155 return 1;
156}
157
158=head2 $self->recurse_match( $c, $parent, \@path_parts )
159
05a90578 160Recursive search for a matching chain.
141459fa 161
162=cut
163
164sub recurse_match {
165 my ( $self, $c, $parent, $path_parts ) = @_;
be5cb4e4 166 my $children = $self->_children_of->{$parent};
141459fa 167 return () unless $children;
6b495723 168 my $best_action;
141459fa 169 my @captures;
1b04b972 170 TRY: foreach my $try_part (sort { length($b) <=> length($a) }
cdc97b63 171 keys %$children) {
1b04b972 172 # $b then $a to try longest part first
141459fa 173 my @parts = @$path_parts;
174 if (length $try_part) { # test and strip PathPart
175 next TRY unless
176 ($try_part eq join('/', # assemble equal number of parts
177 splice( # and strip them off @parts as well
792b40ac 178 @parts, 0, scalar(@{[split('/', $try_part)]})
179 ))); # @{[]} to avoid split to @_
141459fa 180 }
181 my @try_actions = @{$children->{$try_part}};
182 TRY_ACTION: foreach my $action (@try_actions) {
1c34f703 183 if (my $capture_attr = $action->attributes->{CaptureArgs}) {
f505df49 184
185 # Short-circuit if not enough remaining parts
186 next TRY_ACTION unless @parts >= $capture_attr->[0];
187
141459fa 188 my @captures;
189 my @parts = @parts; # localise
7a7ac23c 190
1c34f703 191 # strip CaptureArgs into list
7a7ac23c 192 push(@captures, splice(@parts, 0, $capture_attr->[0]));
193
141459fa 194 # try the remaining parts against children of this action
6365b527 195 my ($actions, $captures, $action_parts) = $self->recurse_match(
141459fa 196 $c, '/'.$action->reverse, \@parts
197 );
2f381252 198 # No best action currently
199 # OR The action has less parts
200 # OR The action has equal parts but less captured data (ergo more defined)
201 if ($actions &&
202 (!$best_action ||
203 $#$action_parts < $#{$best_action->{parts}} ||
204 ($#$action_parts == $#{$best_action->{parts}} &&
205 $#$captures < $#{$best_action->{captures}}))){
6b495723 206 $best_action = {
207 actions => [ $action, @$actions ],
208 captures=> [ @captures, @$captures ],
209 parts => $action_parts
210 };
211 }
212 }
213 else {
7a7ac23c 214 {
215 local $c->req->{arguments} = [ @{$c->req->args}, @parts ];
216 next TRY_ACTION unless $action->match($c);
217 }
953c176d 218 my $args_attr = $action->attributes->{Args}->[0];
219
220 # No best action currently
221 # OR This one matches with fewer parts left than the current best action,
222 # And therefore is a better match
ac5c933b 223 # OR No parts and this expects 0
953c176d 224 # The current best action might also be Args(0),
225 # but we couldn't chose between then anyway so we'll take the last seen
226
227 if (!$best_action ||
228 @parts < @{$best_action->{parts}} ||
a8194217 229 (!@parts && $args_attr eq 0)){
6b495723 230 $best_action = {
231 actions => [ $action ],
232 captures=> [],
233 parts => \@parts
6b495723 234 }
953c176d 235 }
141459fa 236 }
237 }
238 }
953c176d 239 return @$best_action{qw/actions captures parts/} if $best_action;
141459fa 240 return ();
241}
242
243=head2 $self->register( $c, $action )
244
05a90578 245Calls register_path for every Path attribute for the given $action.
141459fa 246
247=cut
248
249sub register {
250 my ( $self, $c, $action ) = @_;
251
1dc8af44 252 my @chained_attr = @{ $action->attributes->{Chained} || [] };
141459fa 253
1dc8af44 254 return 0 unless @chained_attr;
141459fa 255
2f381252 256 if (@chained_attr > 1) {
141459fa 257 Catalyst::Exception->throw(
5882c86e 258 "Multiple Chained attributes not supported registering ${action}"
141459fa 259 );
260 }
261
ba3c3e86 262 my $children = ($self->_children_of->{ $chained_attr[0] } ||= {});
141459fa 263
264 my @path_part = @{ $action->attributes->{PathPart} || [] };
265
09461385 266 my $part = $action->name;
141459fa 267
09461385 268 if (@path_part == 1 && defined $path_part[0]) {
269 $part = $path_part[0];
141459fa 270 } elsif (@path_part > 1) {
271 Catalyst::Exception->throw(
f3414019 272 "Multiple PathPart attributes not supported registering " . $action->reverse()
141459fa 273 );
274 }
275
8a6a6581 276 if ($part =~ m(^/)) {
277 Catalyst::Exception->throw(
f3414019 278 "Absolute parameters to PathPart not allowed registering " . $action->reverse()
8a6a6581 279 );
280 }
281
792b40ac 282 $action->attributes->{PartPath} = [ $part ];
283
141459fa 284 unshift(@{ $children->{$part} ||= [] }, $action);
285
be5cb4e4 286 $self->_actions->{'/'.$action->reverse} = $action;
792b40ac 287
1c34f703 288 unless ($action->attributes->{CaptureArgs}) {
be5cb4e4 289 unshift(@{ $self->_endpoints }, $action);
792b40ac 290 }
291
292 return 1;
141459fa 293}
294
295=head2 $self->uri_for_action($action, $captures)
296
05a90578 297Get the URI part for the action, using C<$captures> to fill
298the capturing parts.
141459fa 299
300=cut
301
302sub uri_for_action {
303 my ( $self, $action, $captures ) = @_;
304
5882c86e 305 return undef unless ($action->attributes->{Chained}
8b13f357 306 && !$action->attributes->{CaptureArgs});
792b40ac 307
308 my @parts = ();
309 my @captures = @$captures;
310 my $parent = "DUMMY";
311 my $curr = $action;
312 while ($curr) {
1c34f703 313 if (my $cap = $curr->attributes->{CaptureArgs}) {
792b40ac 314 return undef unless @captures >= $cap->[0]; # not enough captures
8b13f357 315 if ($cap->[0]) {
316 unshift(@parts, splice(@captures, -$cap->[0]));
317 }
792b40ac 318 }
319 if (my $pp = $curr->attributes->{PartPath}) {
320 unshift(@parts, $pp->[0])
8b13f357 321 if (defined($pp->[0]) && length($pp->[0]));
792b40ac 322 }
5882c86e 323 $parent = $curr->attributes->{Chained}->[0];
be5cb4e4 324 $curr = $self->_actions->{$parent};
141459fa 325 }
792b40ac 326
327 return undef unless $parent eq '/'; # fail for dangling action
328
329 return undef if @captures; # fail for too many captures
330
331 return join('/', '', @parts);
ac5c933b 332
141459fa 333}
334
ae0e35ee 335=head2 $c->expand_action($action)
336
337Return a list of actions that represents a chained action. See
338L<Catalyst::Dispatcher> for more info. You probably want to
339use the expand_action it provides rather than this directly.
340
341=cut
342
52f71256 343sub expand_action {
344 my ($self, $action) = @_;
345
346 return unless $action->attributes && $action->attributes->{Chained};
347
348 my @chain;
349 my $curr = $action;
350
351 while ($curr) {
352 push @chain, $curr;
353 my $parent = $curr->attributes->{Chained}->[0];
354 $curr = $self->_actions->{$parent};
355 }
356
357 return Catalyst::ActionChain->from_chain([reverse @chain]);
358}
359
e5ecd5bc 360__PACKAGE__->meta->make_immutable;
361
05a90578 362=head1 USAGE
363
364=head2 Introduction
365
366The C<Chained> attribute allows you to chain public path parts together
67869327 367by their private names. A chain part's path can be specified with
368C<PathPart> and can be declared to expect an arbitrary number of
369arguments. The endpoint of the chain specifies how many arguments it
370gets through the C<Args> attribute. C<:Args(0)> would be none at all,
371C<:Args> without an integer would be unlimited. The path parts that
372aren't endpoints are using C<CaptureArgs> to specify how many parameters
373they expect to receive. As an example setup:
05a90578 374
375 package MyApp::Controller::Greeting;
376 use base qw/ Catalyst::Controller /;
377
378 # this is the beginning of our chain
379 sub hello : PathPart('hello') Chained('/') CaptureArgs(1) {
380 my ( $self, $c, $integer ) = @_;
381 $c->stash->{ message } = "Hello ";
382 $c->stash->{ arg_sum } = $integer;
383 }
384
385 # this is our endpoint, because it has no :CaptureArgs
386 sub world : PathPart('world') Chained('hello') Args(1) {
387 my ( $self, $c, $integer ) = @_;
388 $c->stash->{ message } .= "World!";
389 $c->stash->{ arg_sum } += $integer;
390
391 $c->response->body( join "<br/>\n" =>
392 $c->stash->{ message }, $c->stash->{ arg_sum } );
393 }
394
395The debug output provides a separate table for chained actions, showing
67869327 396the whole chain as it would match and the actions it contains. Here's an
397example of the startup output with our actions above:
05a90578 398
399 ...
400 [debug] Loaded Path Part actions:
401 .-----------------------+------------------------------.
402 | Path Spec | Private |
403 +-----------------------+------------------------------+
404 | /hello/*/world/* | /greeting/hello (1) |
405 | | => /greeting/world |
406 '-----------------------+------------------------------'
407 ...
408
67869327 409As you can see, Catalyst only deals with chains as whole paths and
410builds one for each endpoint, which are the actions with C<:Chained> but
411without C<:CaptureArgs>.
05a90578 412
413Let's assume this application gets a request at the path
67869327 414C</hello/23/world/12>. What happens then? First, Catalyst will dispatch
415to the C<hello> action and pass the value C<23> as an argument to it
416after the context. It does so because we have previously used
417C<:CaptureArgs(1)> to declare that it has one path part after itself as
418its argument. We told Catalyst that this is the beginning of the chain
419by specifying C<:Chained('/')>. Also note that instead of saying
420C<:PathPart('hello')> we could also just have said C<:PathPart>, as it
421defaults to the name of the action.
05a90578 422
423After C<hello> has run, Catalyst goes on to dispatch to the C<world>
67869327 424action. This is the last action to be called: Catalyst knows this is an
425endpoint because we did not specify a C<:CaptureArgs>
426attribute. Nevertheless we specify that this action expects an argument,
427but at this point we're using C<:Args(1)> to do that. We could also have
428said C<:Args> or left it out altogether, which would mean this action
429would get all arguments that are there. This action's C<:Chained>
430attribute says C<hello> and tells Catalyst that the C<hello> action in
431the current controller is its parent.
05a90578 432
433With this we have built a chain consisting of two public path parts.
67869327 434C<hello> captures one part of the path as its argument, and also
435specifies the path root as its parent. So this part is
436C</hello/$arg>. The next part is the endpoint C<world>, expecting one
437argument. It sums up to the path part C<world/$arg>. This leads to a
438complete chain of C</hello/$arg/world/$arg> which is matched against the
439requested paths.
440
441This example application would, if run and called by e.g.
442C</hello/23/world/12>, set the stash value C<message> to "Hello" and the
443value C<arg_sum> to "23". The C<world> action would then append "World!"
444to C<message> and add C<12> to the stash's C<arg_sum> value. For the
445sake of simplicity no view is shown. Instead we just put the values of
446the stash into our body. So the output would look like:
05a90578 447
448 Hello World!
449 35
450
67869327 451And our test server would have given us this debugging output for the
05a90578 452request:
453
454 ...
455 [debug] "GET" request for "hello/23/world/12" from "127.0.0.1"
456 [debug] Path is "/greeting/world"
457 [debug] Arguments are "12"
458 [info] Request took 0.164113s (6.093/s)
459 .------------------------------------------+-----------.
460 | Action | Time |
461 +------------------------------------------+-----------+
462 | /greeting/hello | 0.000029s |
463 | /greeting/world | 0.000024s |
464 '------------------------------------------+-----------'
465 ...
466
67869327 467What would be common uses of this dispatch technique? It gives the
468possibility to split up logic that contains steps that each depend on
469each other. An example would be, for example, a wiki path like
05a90578 470C</wiki/FooBarPage/rev/23/view>. This chain can be easily built with
471these actions:
472
473 sub wiki : PathPart('wiki') Chained('/') CaptureArgs(1) {
474 my ( $self, $c, $page_name ) = @_;
475 # load the page named $page_name and put the object
476 # into the stash
477 }
478
479 sub rev : PathPart('rev') Chained('wiki') CaptureArgs(1) {
480 my ( $self, $c, $revision_id ) = @_;
67869327 481 # use the page object in the stash to get at its
05a90578 482 # revision with number $revision_id
483 }
484
485 sub view : PathPart Chained('rev') Args(0) {
486 my ( $self, $c ) = @_;
67869327 487 # display the revision in our stash. Another option
05a90578 488 # would be to forward a compatible object to the action
489 # that displays the default wiki pages, unless we want
490 # a different interface here, for example restore
491 # functionality.
492 }
493
67869327 494It would now be possible to add other endpoints, for example C<restore>
495to restore this specific revision as the current state.
05a90578 496
67869327 497You don't have to put all the chained actions in one controller. The
498specification of the parent through C<:Chained> also takes an absolute
499action path as its argument. Just specify it with a leading C</>.
05a90578 500
501If you want, for example, to have actions for the public paths
67869327 502C</foo/12/edit> and C</foo/12>, just specify two actions with
05a90578 503C<:PathPart('foo')> and C<:Chained('/')>. The handler for the former
67869327 504path needs a C<:CaptureArgs(1)> attribute and a endpoint with
05a90578 505C<:PathPart('edit')> and C<:Chained('foo')>. For the latter path give
506the action just a C<:Args(1)> to mark it as endpoint. This sums up to
507this debugging output:
508
509 ...
510 [debug] Loaded Path Part actions:
511 .-----------------------+------------------------------.
512 | Path Spec | Private |
513 +-----------------------+------------------------------+
514 | /foo/* | /controller/foo_view |
515 | /foo/*/edit | /controller/foo_load (1) |
516 | | => /controller/edit |
517 '-----------------------+------------------------------'
518 ...
519
ac5c933b 520Here's a more detailed specification of the attributes belonging to
05a90578 521C<:Chained>:
522
523=head2 Attributes
524
525=over 8
526
527=item PathPart
528
529Sets the name of this part of the chain. If it is specified without
530arguments, it takes the name of the action as default. So basically
531C<sub foo :PathPart> and C<sub foo :PathPart('foo')> are identical.
532This can also contain slashes to bind to a deeper level. An action
533with C<sub bar :PathPart('foo/bar') :Chained('/')> would bind to
534C</foo/bar/...>. If you don't specify C<:PathPart> it has the same
535effect as using C<:PathPart>, it would default to the action name.
536
d21a2b27 537=item PathPrefix
538
539Sets PathPart to the path_prefix of the current controller.
540
05a90578 541=item Chained
542
543Has to be specified for every child in the chain. Possible values are
d21a2b27 544absolute and relative private action paths or a single slash C</> to
545tell Catalyst that this is the root of a chain. The attribute
546C<:Chained> without arguments also defaults to the C</> behavior.
547Relative action paths may use C<../> to refer to actions in parent
548controllers.
05a90578 549
67869327 550Because you can specify an absolute path to the parent action, it
551doesn't matter to Catalyst where that parent is located. So, if your
552design requests it, you can redispatch a chain through any controller or
553namespace you want.
05a90578 554
555Another interesting possibility gives C<:Chained('.')>, which chains
67869327 556itself to an action with the path of the current controller's namespace.
05a90578 557For example:
558
559 # in MyApp::Controller::Foo
560 sub bar : Chained CaptureArgs(1) { ... }
561
562 # in MyApp::Controller::Foo::Bar
563 sub baz : Chained('.') Args(1) { ... }
564
565This builds up a chain like C</bar/*/baz/*>. The specification of C<.>
67869327 566as the argument to Chained here chains the C<baz> action to an action
567with the path of the current controller namespace, namely
568C</foo/bar>. That action chains directly to C</>, so the C</bar/*/baz/*>
569chain comes out as the end product.
05a90578 570
d21a2b27 571=item ChainedParent
572
573Chains an action to another action with the same name in the parent
574controller. For Example:
575
576 # in MyApp::Controller::Foo
577 sub bar : Chained CaptureArgs(1) { ... }
578
579 # in MyApp::Controller::Foo::Moo
580 sub bar : ChainedParent Args(1) { ... }
581
582This builds a chain like C</bar/*/bar/*>.
583
05a90578 584=item CaptureArgs
585
67869327 586Must be specified for every part of the chain that is not an
05a90578 587endpoint. With this attribute Catalyst knows how many of the following
67869327 588parts of the path (separated by C</>) this action wants to capture as
589its arguments. If it doesn't expect any, just specify
590C<:CaptureArgs(0)>. The captures get passed to the action's C<@_> right
591after the context, but you can also find them as array references in
05a90578 592C<$c-E<gt>request-E<gt>captures-E<gt>[$level]>. The C<$level> is the
593level of the action in the chain that captured the parts of the path.
594
67869327 595An action that is part of a chain (that is, one that has a C<:Chained>
596attribute) but has no C<:CaptureArgs> attribute is treated by Catalyst
597as a chain end.
05a90578 598
599=item Args
600
601By default, endpoints receive the rest of the arguments in the path. You
602can tell Catalyst through C<:Args> explicitly how many arguments your
603endpoint expects, just like you can with C<:CaptureArgs>. Note that this
67869327 604also affects whether this chain is invoked on a request. A chain with an
05a90578 605endpoint specifying one argument will only match if exactly one argument
606exists in the path.
607
608You can specify an exact number of arguments like C<:Args(3)>, including
609C<0>. If you just say C<:Args> without any arguments, it is the same as
67869327 610leaving it out altogether: The chain is matched regardless of the number
05a90578 611of path parts after the endpoint.
612
67869327 613Just as with C<:CaptureArgs>, the arguments get passed to the action in
05a90578 614C<@_> after the context object. They can also be reached through
615C<$c-E<gt>request-E<gt>arguments>.
616
617=back
618
67869327 619=head2 Auto actions, dispatching and forwarding
05a90578 620
621Note that the list of C<auto> actions called depends on the private path
67869327 622of the endpoint of the chain, not on the chained actions way. The
623C<auto> actions will be run before the chain dispatching begins. In
624every other aspect, C<auto> actions behave as documented.
05a90578 625
626The C<forward>ing to other actions does just what you would expect. But if
627you C<detach> out of a chain, the rest of the chain will not get called
67869327 628after the C<detach>.
05a90578 629
2f381252 630=head1 AUTHORS
141459fa 631
2f381252 632Catalyst Contributors, see Catalyst.pm
141459fa 633
634=head1 COPYRIGHT
635
636This program is free software, you can redistribute it and/or modify it under
637the same terms as Perl itself.
638
639=cut
640
6411;