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);
88 my $count = $self->_count_positional_arguments($method);
89 $attributes{CaptureArgs} = $count
95 unless ($attributes{Private}) {
96 $attributes{PathPart} ||= "'$name'";
98 delete $attributes{CaptureArgs}
99 if exists $attributes{Args};
101 $attributes{CaptureArgs} = 0
102 unless exists $attributes{Args}
103 or exists $attributes{CaptureArgs};
106 if ($attributes{Private}) {
107 delete $attributes{ $_ }
108 for qw( Args CaptureArgs Chained Signature Subname Action );
111 if ($ctx->peek_next_char eq '{') {
112 $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
115 $ctx->inject_code_parts_here(
117 $ctx->scope_injector_call,
118 $method->injectable_code,
123 for my $attr (keys %attributes) {
125 map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
126 (ref($attributes{ $attr }) eq 'ARRAY')
127 ? @{ $attributes{ $attr } }
128 : $attributes{ $attr };
131 return $ctx->shadow(sub (&) {
135 $method->_set_actual_body($body);
136 $method->{attributes} = \@attributes;
140 add_method_modifier $class, $modifier, [$name, $method];
144 $class->meta->add_method($name, $method);
145 $class->meta->register_method_attributes($class->can($method->name), \@attributes);
150 method _handle_with_option (Object $ctx, HashRef $attrs) {
152 my $role = $ctx->strip_name
153 or croak "Expected bareword role specification for action after with";
155 # we need to fish for aliases here since we are still unclean
156 if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
160 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
165 method _handle_isa_option (Object $ctx, HashRef $attrs) {
167 my $class = $ctx->strip_name
168 or croak "Expected bareword action class specification for action after isa";
170 if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
174 $attrs->{CatalystX_Declarative_ActionClass} = $class;
179 method _check_for_available_import (Object $ctx, Str $name) {
181 if (my $code = $ctx->get_curstash_name->can($name)) {
188 method _handle_action_option (Object $ctx, HashRef $attrs) {
191 my $name = $ctx->strip_name
192 or croak "Anonymous actions not yet supported";
197 if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
198 my $linestr = $ctx->get_linestr;
199 substr($linestr, $ctx->offset, 2) = '';
200 $ctx->set_linestr($linestr);
201 $populator = $self->_handle_under_option($ctx, $attrs);
205 my $proto = $ctx->strip_proto || '';
206 $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
208 $attrs->{Subname} = $name;
209 $attrs->{Signature} = $proto;
210 $attrs->{Action} = [];
212 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
214 if (defined $CatalystX::Declare::SCOPE::UNDER) {
215 $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
218 return unless $populator;
222 method _handle_final_option (Object $ctx, HashRef $attrs) {
224 return $self->_build_flag_populator($ctx, $attrs, 'final');
227 method _handle_is_option (Object $ctx, HashRef $attrs) {
229 my $what = $ctx->strip_name
230 or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
232 return $self->_build_flag_populator($ctx, $attrs, $what);
235 method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
240 if ($what eq any qw( end endpoint final )) {
241 $attrs->{Args} = delete $attrs->{CaptureArgs};
243 elsif ($what eq 'private') {
244 $attrs->{Private} = [];
249 method _handle_under_option (Object $ctx, HashRef $attrs) {
251 my $target = $self->_strip_actionpath($ctx);
254 if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
255 $ctx->inject_if_block(
256 sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
257 $ctx->scope_injector_call,
265 $attrs->{Chained} = "'$target'";
272 method _handle_chains_option (Object $ctx, HashRef $attrs) {
275 $ctx->strip_name eq 'to'
276 or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);
278 return $self->_handle_under_option($ctx, $attrs);
281 method _handle_as_option (Object $ctx, HashRef $attrs) {
285 my $path = $self->_strip_actionpath($ctx);
286 $attrs->{PathPart} = "'$path'";
291 method _count_positional_arguments (Object $method) {
292 my $signature = $method->_parsed_signature;
294 if ($signature->has_positional_params) {
295 my $count = @{ scalar($signature->positional_params) };
297 if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
307 method _strip_actionpath (Object $ctx) {
310 my $linestr = $ctx->get_linestr;
311 my $rest = substr($linestr, $ctx->offset);
313 if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
314 substr($linestr, $ctx->offset, length($1)) = '';
315 $ctx->set_linestr($linestr);
318 elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
319 substr($linestr, $ctx->offset, length($1) + 2) = '';
320 $ctx->set_linestr($linestr);
324 croak "Invalid syntax for action path: $rest";
333 CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
337 use CatalystX::Declare;
339 controller MyApp::Web::Controller::Example {
341 # chain base action with path part setting of ''
342 # body-less actions don't do anything by themselves
343 action base as '' under '/';
345 # simple end-point action
346 action controller_class is final under base {
347 $ctx->response->body( 'controller: ' . ref $self );
350 # chain part actions can have arguments
351 action str (Str $string) under base {
353 $ctx->stash(chars => [split //, $string]);
356 # and end point actions too, of course
357 action uc_chars (Int $count) under str is final {
359 my $chars = $ctx->stash->{chars};
364 # you can use a shortcut for multiple actions with
368 # this is an endpoint after base
369 action normal is final;
371 # the final keyword can be used to be more
372 # visually explicit about end-points
373 final action some_action { ... }
376 # of course you can also chain to external actions
377 final action some_end under '/some/controller/some/action';
382 This handler class provides the user with C<action>, C<final> and C<under>
383 keywords. There are multiple ways to define actions to allow for greater
384 freedom of expression. While the parts of the action declaration itself do
385 not care about their order, their syntax is rather strict.
387 You can choose to separate syntax elements via C<,> if you think it is more
388 readable. The action declaration
390 action foo is final under base;
392 is parsed in exactly the same way if you write it as
394 action foo, is final, under base;
396 =head2 Basic Action Declaration
398 The simplest possible declaration is
402 This would define a chain-part action chained to nothing with the name C<foo>
403 and no arguments. Since it isn't followed by a block, the body of the action
406 You will automatically be provided with two variables: C<$self> is, as you
407 might expect, your controller instance. C<$ctx> will be the Catalyst context
408 object. Thus, the following code would stash the value returned by the
412 $ctx->stash(item => $self->get_item);
415 =head2 Setting a Path Part
417 As usual with Catalyst actions, the path part (the public name of this part of
418 the URI, if you're not familiar with the term yet) will default to the name of
419 the action itself (or more correctly: to whatever Catalyst defaults).
421 To change that, use the C<as> option:
424 action base as ''; # <empty>
425 action something as 'foo/bar'; # foo/bar
426 action barely as bareword; # bareword
429 =head2 Chaining Actions
431 Currently, L<CatalystX::Declare> is completely based on the concept of
432 L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
433 chained or private. You can specify the action you want to chain to with the
436 action foo; # chained to nothing
437 action foo under '/'; # also chained to /
438 action foo under bar; # chained to the local bar action
439 action foo under '/bar/baz'; # chained to baz in /bar
441 C<under> is also provided as a grouping keyword. Every action inside the block
442 will be chained to the specified action:
449 You can also use the C<under> keyword for a single action. This is useful if
450 you want to highlight a single action with a significant diversion from what
453 action base under '/';
455 under '/the/sink' is final action foo;
457 final action bar under base;
459 final action baz under base;
461 Instead of the C<under> option declaration, you can also use a more english
462 variant named C<chains to>. While C<under> might be nice and concise, some
463 people might prefer this if they confuse C<under> with the specification of
464 a public path part. The argument to C<chains to> is the same as to C<under>:
466 action foo chains to bar;
467 action foo under bar;
469 By default all actions are chain-parts, not end-points. If you want an action
470 to be picked up as end-point and available via a public path, you have to say
471 so explicitely by using the C<is final> option:
473 action base under '/';
474 action foo under base is final; # /base/foo
476 You can also drop the C<is> part of the C<is final> option if you want:
478 under base, final action foo { ... }
480 You can make end-points more visually distinct by using the C<final> keyword
481 instead of the option:
483 action base under '/';
484 final action foo under base; # /base/foo
486 And of course, the C<final>, C<under> and C<action> keywords can be used in
487 combination whenever needed:
489 action base as '' under '/';
493 final action list; # /list
499 final action view; # /list/load/view
500 final action edit; # /list/load/edit
504 There is also one shorthand alternative for declaring chain targets. You can
505 specify an action after a C<E<lt>-> following the action name:
507 action base under '/';
508 final action foo <- base; # /base/foo
512 You can use signatures like you are use to from L<MooseX::Method::Signatures>
513 to declare action parameters. The number of arguments will be used during
514 dispatching. Dispatching by type constraint is planned but not yet implemented.
516 The signature follows the action name:
519 final action foo (Int $year, Int $month, Int $day);
521 If you are using the shorthand definition, the signature follows the chain
525 final action foo <- base ($x) under '/' { ... }
527 Parameters may be specified on chain-parts and end-points:
530 action base (Str $lang) under '/';
531 final action page (Int $page_num) under base;
533 Named parameters will be populated with the values in the query parameters:
536 final action view (Int $id, Int :$page = 1) under '/';
538 Your end-points can also take an unspecified amount of arguments by specifying
539 an array as a variable:
541 # /find/some/deep/path/spec
542 final action find (@path) under '/';
546 Currently, when the arguments do not fit the signature because of a L<Moose>
547 validation error, the response body will be set to C<Bad Request> and the
550 =head2 Actions and Method Modifiers
552 Method modifiers can not only be applied to methods, but also to actions. There
553 is no way yet to override the attributes of an already established action via
554 modifiers. However, you can modify the method underlying the action.
556 The following code is an example role modifying the consuming controller's
559 use CatalystX::Declare;
561 component_role MyApp::Web::ControllerRole::RichBase {
563 before base (Object $ctx) {
564 $ctx->stash(something => $ctx->model('Item'));
568 Note that you have to specify the C<$ctx> argument yourself, since you are
569 modifying a method, not an action.
571 Any controller having a C<base> action (or method, for this purpose), can now
572 consume the C<RichBase> role declared above:
574 use CatalystX::Declare;
576 controller MyApp::Web::Controller::Foo
577 with MyApp::Web::Controller::RichBase {
579 action base as '' under '/';
581 action show, final under base {
582 $ctx->response->body(
583 $ctx->stash->{something}->render,
592 =item L<MooseX::Declare::Syntax::KeywordHandling>
598 These methods are implementation details. Unless you are extending or
599 developing L<CatalystX::Declare>, you should not be concerned with them.
603 Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
605 A hook that will be invoked by L<MooseX::Declare> when this instance is called
606 to handle syntax. It will parse the action declaration, prepare attributes and
607 add the actions to the controller.
613 =item L<CatalystX::Declare>
615 =item L<CatalystX::Declare::Keyword::Controller>
617 =item L<MooseX::Method::Signatures>
623 See L<CatalystX::Declare/AUTHOR> for author information.
627 This program is free software; you can redistribute it and/or modify it under
628 the same terms as perl itself.