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