3 class CatalystX::Declare::Keyword::Action
4 with MooseX::Declare::Syntax::KeywordHandling {
8 use Perl6::Junction qw( any );
9 use Data::Dump qw( pp );
10 use MooseX::Types::Util qw( has_available_type_export );
11 use Moose::Util qw( add_method_modifier );
16 use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
17 use constant UNDER_VAR => '$CatalystX::Declare::SCOPE::UNDER';
19 use aliased 'CatalystX::Declare::Action::CatchValidationError';
20 use aliased 'MooseX::Method::Signatures::Meta::Method';
21 use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
24 method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
26 # somewhere to put the attributes
31 until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
36 if ($ctx->peek_next_char eq ',') {
38 my $linestr = $ctx->get_linestr;
39 substr($linestr, $ctx->offset, 1) = '';
40 $ctx->set_linestr($linestr);
45 # next thing should be an option name
50 $ctx->skip_declarator;
51 $skipped_declarator++;
54 or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);
56 # we need to be able to handle the rest
57 my $handler = $self->can("_handle_${option}_option")
58 or croak "Unknown action option: $option";
61 my $populator = $self->$handler($ctx, \%attributes);
63 if ($populator and $populator eq STOP_PARSING) {
65 return $ctx->shadow(sub (&) {
71 push @populators, $populator
72 if defined $populator;
75 croak "Need an action specification"
76 unless exists $attributes{Signature};
78 my $name = $attributes{Subname};
80 my $method = Method->wrap(
81 signature => qq{($attributes{Signature})},
82 package_name => $ctx->get_curstash_name,
86 AttributeRole->meta->apply($method);
91 unless ($attributes{Private}) {
92 $attributes{PathPart} ||= "'$name'";
94 delete $attributes{CaptureArgs}
95 if exists $attributes{Args};
97 $attributes{CaptureArgs} = 0
98 unless exists $attributes{Args}
99 or exists $attributes{CaptureArgs};
102 if ($attributes{Private}) {
103 delete $attributes{ $_ }
104 for qw( Args CaptureArgs Chained Signature Subname Action );
107 if ($ctx->peek_next_char eq '{') {
108 $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
111 $ctx->inject_code_parts_here(
113 $ctx->scope_injector_call,
114 $method->injectable_code,
119 for my $attr (keys %attributes) {
121 map { sprintf '%s(%s)', $attr, $_ }
122 (ref($attributes{ $attr }) eq 'ARRAY')
123 ? @{ $attributes{ $attr } }
124 : $attributes{ $attr };
127 return $ctx->shadow(sub (&) {
131 $method->_set_actual_body($body);
132 $method->{attributes} = \@attributes;
136 add_method_modifier $class, $modifier, [$name, $method];
140 $class->meta->add_method($name, $method);
141 $class->meta->register_method_attributes($class->can($method->name), \@attributes);
146 method _handle_with_option (Object $ctx, HashRef $attrs) {
148 my $role = $ctx->strip_name
149 or croak "Expected bareword role specification for action after with";
151 # we need to fish for aliases here since we are still unclean
152 if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
156 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
161 method _handle_isa_option (Object $ctx, HashRef $attrs) {
163 my $class = $ctx->strip_name
164 or croak "Expected bareword action class specification for action after isa";
166 if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
170 $attrs->{CatalystX_Declarative_ActionClass} = $class;
175 method _check_for_available_import (Object $ctx, Str $name) {
177 if (my $code = $ctx->get_curstash_name->can($name)) {
184 method _handle_action_option (Object $ctx, HashRef $attrs) {
187 my $name = $ctx->strip_name
188 or croak "Anonymous actions not yet supported";
193 if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
194 my $linestr = $ctx->get_linestr;
195 substr($linestr, $ctx->offset, 2) = '';
196 $ctx->set_linestr($linestr);
197 $populator = $self->_handle_under_option($ctx, $attrs);
201 my $proto = $ctx->strip_proto || '';
202 $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
204 $attrs->{Subname} = $name;
205 $attrs->{Signature} = $proto;
206 $attrs->{Action} = [];
208 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
210 if (defined $CatalystX::Declare::SCOPE::UNDER) {
211 $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
214 return unless $populator;
218 method _handle_final_option (Object $ctx, HashRef $attrs) {
220 return $self->_build_flag_populator($ctx, $attrs, 'final');
223 method _handle_is_option (Object $ctx, HashRef $attrs) {
225 my $what = $ctx->strip_name
226 or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
228 return $self->_build_flag_populator($ctx, $attrs, $what);
231 method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
236 if ($what eq any qw( end endpoint final )) {
237 my $count = $self->_count_positional_arguments($method);
238 $attrs->{Args} = defined($count) ? $count : '';
240 elsif ($what eq 'private') {
241 $attrs->{Private} = [];
246 method _handle_under_option (Object $ctx, HashRef $attrs) {
248 my $target = $self->_strip_actionpath($ctx);
251 if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
252 $ctx->inject_if_block(
253 sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
254 $ctx->scope_injector_call,
262 $attrs->{Chained} = "'$target'";
267 my $count = $self->_count_positional_arguments($method);
268 $attrs->{CaptureArgs} = $count
273 method _handle_chains_option (Object $ctx, HashRef $attrs) {
276 $ctx->strip_name eq 'to'
277 or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);
279 return $self->_handle_under_option($ctx, $attrs);
282 method _handle_as_option (Object $ctx, HashRef $attrs) {
286 my $path = $self->_strip_actionpath($ctx);
287 $attrs->{PathPart} = "'$path'";
292 method _count_positional_arguments (Object $method) {
293 my $signature = $method->_parsed_signature;
295 if ($signature->has_positional_params) {
296 my $count = @{ scalar($signature->positional_params) };
298 if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
308 method _strip_actionpath (Object $ctx) {
311 my $linestr = $ctx->get_linestr;
312 my $rest = substr($linestr, $ctx->offset);
314 if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
315 substr($linestr, $ctx->offset, length($1)) = '';
316 $ctx->set_linestr($linestr);
319 elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
320 substr($linestr, $ctx->offset, length($1) + 2) = '';
321 $ctx->set_linestr($linestr);
325 croak "Invalid syntax for action path: $rest";
334 CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
338 use CatalystX::Declare;
340 controller MyApp::Web::Controller::Example {
342 # chain base action with path part setting of ''
343 # body-less actions don't do anything by themselves
344 action base as '' under '/';
346 # simple end-point action
347 action controller_class is final under base {
348 $ctx->response->body( 'controller: ' . ref $self );
351 # chain part actions can have arguments
352 action str (Str $string) under base {
354 $ctx->stash(chars => [split //, $string]);
357 # and end point actions too, of course
358 action uc_chars (Int $count) under str is final {
360 my $chars = $ctx->stash->{chars};
365 # you can use a shortcut for multiple actions with
369 # this is an endpoint after base
370 action normal is final;
372 # the final keyword can be used to be more
373 # visually explicit about end-points
374 final action some_action { ... }
377 # of course you can also chain to external actions
378 final action some_end under '/some/controller/some/action';
383 This handler class provides the user with C<action>, C<final> and C<under>
384 keywords. There are multiple ways to define actions to allow for greater
385 freedom of expression. While the parts of the action declaration itself do
386 not care about their order, their syntax is rather strict.
388 You can choose to separate syntax elements via C<,> if you think it is more
389 readable. The action declaration
391 action foo is final under base;
393 is parsed in exactly the same way if you write it as
395 action foo, is final, under base;
397 =head2 Basic Action Declaration
399 The simplest possible declaration is
403 This would define a chain-part action chained to nothing with the name C<foo>
404 and no arguments. Since it isn't followed by a block, the body of the action
407 You will automatically be provided with two variables: C<$self> is, as you
408 might expect, your controller instance. C<$ctx> will be the Catalyst context
409 object. Thus, the following code would stash the value returned by the
413 $ctx->stash(item => $self->get_item);
416 =head2 Setting a Path Part
418 As usual with Catalyst actions, the path part (the public name of this part of
419 the URI, if you're not familiar with the term yet) will default to the name of
420 the action itself (or more correctly: to whatever Catalyst defaults).
422 To change that, use the C<as> option:
425 action base as ''; # <empty>
426 action something as 'foo/bar'; # foo/bar
427 action barely as bareword; # bareword
430 =head2 Chaining Actions
432 Currently, L<CatalystX::Declare> is completely based on the concept of
433 L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
434 chained or private. You can specify the action you want to chain to with the
437 action foo; # chained to nothing
438 action foo under '/'; # also chained to /
439 action foo under bar; # chained to the local bar action
440 action foo under '/bar/baz'; # chained to baz in /bar
442 C<under> is also provided as a grouping keyword. Every action inside the block
443 will be chained to the specified action:
450 You can also use the C<under> keyword for a single action. This is useful if
451 you want to highlight a single action with a significant diversion from what
454 action base under '/';
456 under '/the/sink' is final action foo;
458 final action bar under base;
460 final action baz under base;
462 Instead of the C<under> option declaration, you can also use a more english
463 variant named C<chains to>. While C<under> might be nice and concise, some
464 people might prefer this if they confuse C<under> with the specification of
465 a public path part. The argument to C<chains to> is the same as to C<under>:
467 action foo chains to bar;
468 action foo under bar;
470 By default all actions are chain-parts, not end-points. If you want an action
471 to be picked up as end-point and available via a public path, you have to say
472 so explicitely by using the C<is final> option:
474 action base under '/';
475 action foo under base is final; # /base/foo
477 You can also drop the C<is> part of the C<is final> option if you want:
479 under base, final action foo { ... }
481 You can make end-points more visually distinct by using the C<final> keyword
482 instead of the option:
484 action base under '/';
485 final action foo under base; # /base/foo
487 And of course, the C<final>, C<under> and C<action> keywords can be used in
488 combination whenever needed:
490 action base as '' under '/';
494 final action list; # /list
500 final action view; # /list/load/view
501 final action edit; # /list/load/edit
505 There is also one shorthand alternative for declaring chain targets. You can
506 specify an action after a C<E<lt>-> following the action name:
508 action base under '/';
509 final action foo <- base; # /base/foo
513 You can use signatures like you are use to from L<MooseX::Method::Signatures>
514 to declare action parameters. The number of arguments will be used during
515 dispatching. Dispatching by type constraint is planned but not yet implemented.
517 The signature follows the action name:
520 final action foo (Int $year, Int $month, Int $day);
522 If you are using the shorthand definition, the signature follows the chain
526 final action foo <- base ($x) under '/' { ... }
528 Parameters may be specified on chain-parts and end-points:
531 action base (Str $lang) under '/';
532 final action page (Int $page_num) under base;
534 Named parameters will be populated with the values in the query parameters:
537 final action view (Int $id, Int :$page = 1) under '/';
539 Your end-points can also take an unspecified amount of arguments by specifying
540 an array as a variable:
542 # /find/some/deep/path/spec
543 final action find (@path) under '/';
547 Currently, when the arguments do not fit the signature because of a L<Moose>
548 validation error, the response body will be set to C<Bad Request> and the
551 =head2 Actions and Method Modifiers
553 Method modifiers can not only be applied to methods, but also to actions. There
554 is no way yet to override the attributes of an already established action via
555 modifiers. However, you can modify the method underlying the action.
557 The following code is an example role modifying the consuming controller's
560 use CatalystX::Declare;
562 controller_role MyApp::Web::ControllerRole::RichBase {
564 before base (Object $ctx) {
565 $ctx->stash(something => $ctx->model('Item'));
569 Note that you have to specify the C<$ctx> argument yourself, since you are
570 modifying a method, not an action.
572 Any controller having a C<base> action (or method, for this purpose), can now
573 consume the C<RichBase> role declared above:
575 use CatalystX::Declare;
577 controller MyApp::Web::Controller::Foo
578 with MyApp::Web::Controller::RichBase {
580 action base as '' under '/';
582 action show, final under base {
583 $ctx->response->body(
584 $ctx->stash->{something}->render,
593 =item L<MooseX::Declare::Syntax::KeywordHandling>
599 These methods are implementation details. Unless you are extending or
600 developing L<CatalystX::Declare>, you should not be concerned with them.
604 Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
606 A hook that will be invoked by L<MooseX::Declare> when this instance is called
607 to handle syntax. It will parse the action declaration, prepare attributes and
608 add the actions to the controller.
614 =item L<CatalystX::Declare>
616 =item L<CatalystX::Declare::Keyword::Controller>
618 =item L<MooseX::Method::Signatures>
624 See L<CatalystX::Declare/AUTHOR> for author information.
628 This program is free software; you can redistribute it and/or modify it under
629 the same terms as perl itself.