2 use MooseX::Role::Parameterized ();
4 class CatalystX::Declare::Keyword::Action {
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 ensure_all_roles );
16 use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
17 use constant UNDER_VAR => '$CatalystX::Declare::SCOPE::UNDER';
18 use constant UNDER_STACK => '@CatalystX::Declare::SCOPE::UNDER_STACK';
20 use aliased 'CatalystX::Declare::Action::CatchValidationError';
21 use aliased 'CatalystX::Declare::Context::StringParsing';
22 use aliased 'MooseX::Method::Signatures::Meta::Method';
23 use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
24 use aliased 'MooseX::MethodAttributes::Role::Meta::Role', 'AttributeMetaRole';
27 method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
29 # somewhere to put the attributes
34 until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
39 if ($ctx->peek_next_char eq ',') {
41 my $linestr = $ctx->get_linestr;
42 substr($linestr, $ctx->offset, 1) = '';
43 $ctx->set_linestr($linestr);
48 # next thing should be an option name
53 $ctx->skip_declarator;
54 $skipped_declarator++;
57 or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);
59 # we need to be able to handle the rest
60 my $handler = $self->can("_handle_${option}_option")
61 or croak "Unknown action option: $option";
64 my $populator = $self->$handler($ctx, \%attributes);
66 if ($populator and $populator eq STOP_PARSING) {
68 return $ctx->shadow(sub (&) {
74 push @populators, $populator
75 if defined $populator;
78 croak "Need an action specification"
79 unless exists $attributes{Signature};
81 my $name = $attributes{Subname};
83 if ($attributes{Private}) {
84 $attributes{Signature} ||= '@';
87 my $method = Method->wrap(
88 signature => qq{($attributes{Signature})},
89 package_name => $ctx->get_curstash_name,
93 AttributeRole->meta->apply($method);
95 my $count = $self->_count_positional_arguments($method);
96 $attributes{CaptureArgs} = $count
102 unless ($attributes{Private}) {
103 $attributes{PathPart} ||= $name;
105 delete $attributes{CaptureArgs}
106 if exists $attributes{Args};
108 $attributes{CaptureArgs} = 0
109 unless exists $attributes{Args}
110 or exists $attributes{CaptureArgs};
113 if ($attributes{Private}) {
114 delete $attributes{ $_ }
115 for qw( Args CaptureArgs Chained Signature Private );
118 # inject a hashref for resolving runtime attribute values
119 $self->_inject_attributes($ctx, \%attributes);
121 # our declaration is followed by a block
122 if ($ctx->peek_next_char eq '{') {
123 $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
126 # there is no block, so we insert one.
128 $ctx->inject_code_parts_here(
130 $ctx->scope_injector_call,
131 $method->injectable_code,
135 my $compile_attrs = sub {
136 my $attributes = shift;;
139 for my $attr (keys %$attributes) {
140 my $value = $attributes->{ $attr };
142 # the compiletime chained attr might contain the under global var name
143 next if $attr eq 'Chained' and $value eq UNDER_VAR;
146 map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
147 (ref($value) eq 'ARRAY')
155 return $ctx->shadow(sub {
160 # the runtime-resolved name
161 my $name = $attrs->{Subname};
163 # in case no hashref was specified
164 $body = $attrs and $attrs = {}
165 if ref $attrs eq 'CODE';
167 # default path part to runtime-resolved name
168 unless ($attrs->{Private}) {
170 $attrs->{PathPart} = $attrs->{Subname}
171 unless defined $attrs->{PathPart};
174 # in CXD we are explicit about chained values, an undefined
175 # value means we defaulted to the outer-scope under and there
177 delete $attrs->{Chained}
178 unless defined $attrs->{Chained};
180 # some attrs need to be single quoted in their stringified forms
181 defined($attrs->{ $_ }) and $attrs->{ $_ } = sprintf "'%s'", $attrs->{ $_ }
182 for qw( Chained PathPart );
184 # merge runtime and compiletime attrs
185 my %full_attrs = (%attributes, %$attrs);
186 my $compiled_attrs = $compile_attrs->(\%full_attrs);
188 my $real_method = $method->reify(
189 actual_body => $body,
190 attributes => $compiled_attrs,
197 add_method_modifier $class, $modifier, [$name, $real_method];
201 my $prepare_meta = sub {
204 $meta->add_method($name, $real_method);
205 $meta->register_method_attributes($meta->name->can($real_method->name), $compiled_attrs);
208 if ($ctx->stack->[-1] and $ctx->stack->[-1]->is_parameterized) {
209 my $real_meta = MooseX::Role::Parameterized->current_metaclass;
211 $real_meta->meta->make_mutable
212 if $real_meta->meta->is_immutable;
213 ensure_all_roles $real_meta->meta, AttributeMetaRole
214 if $real_meta->isa('Moose::Meta::Role');
216 $real_meta->$prepare_meta;
220 $class->meta->$prepare_meta;
226 method _handle_with_option (Object $ctx, HashRef $attrs) {
228 my @roles_with_args = ();
229 push @roles_with_args, @{ $ctx->strip_names_and_args };
231 # we need to fish for aliases here since we are still unclean
233 for my $role_with_arg(@roles_with_args) {
234 my ($role, $params) = @{$role_with_arg};
236 my ($first, @rest) = eval $params;
237 my %params = ref $first eq 'HASH' ? %$first : ($first, @rest); # both (%opts) and {%opts}
238 for my $key (keys %params) {
239 my $parameters = ref $params{$key} eq 'ARRAY' ? @{$params{$key}} : $params{$key};
240 push @{$attrs->{$key}}, $parameters;
244 if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
250 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, @roles;
255 method _handle_isa_option (Object $ctx, HashRef $attrs) {
257 my $class = $ctx->strip_name
258 or croak "Expected bareword action class specification for action after isa";
260 if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
264 $attrs->{CatalystX_Declarative_ActionClass} = $class;
269 method _check_for_available_import (Object $ctx, Str $name) {
271 if (my $code = $ctx->get_curstash_name->can($name)) {
278 method _handle_action_option (Object $ctx, HashRef $attrs) {
281 my $name = $self->_strip_actionpath($ctx, interpolate => 1)
282 or croak "Anonymous actions not yet supported";
287 # shortcut under base option is basically handled by the under handler
288 if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
289 my $linestr = $ctx->get_linestr;
290 substr($linestr, $ctx->offset, 2) = '';
291 $ctx->set_linestr($linestr);
292 $populator = $self->_handle_under_option($ctx, $attrs);
296 my $proto = $ctx->strip_proto || '';
297 $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
299 $attrs->{Subname} = $name;
300 $attrs->{Signature} = $proto;
301 $attrs->{Action} = [];
303 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
305 # default chained base to the global under var, to be resolved at runtime
306 $attrs->{Chained} ||= UNDER_VAR;
308 return unless $populator;
312 method _handle_final_option (Object $ctx, HashRef $attrs) {
314 return $self->_build_flag_populator($ctx, $attrs, 'final');
317 method _handle_is_option (Object $ctx, HashRef $attrs) {
319 my $what = $ctx->strip_name
320 or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
322 return $self->_build_flag_populator($ctx, $attrs, $what);
325 method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
327 $attrs->{Private} = []
328 if $what eq 'private';
333 if ($what eq any qw( end endpoint final )) {
334 $attrs->{Args} = delete $attrs->{CaptureArgs};
336 elsif ($what eq 'private') {
337 $attrs->{Private} = [];
342 method _handle_under_option (Object $ctx, HashRef $attrs) {
344 my $target = $self->_strip_actionpath($ctx, interpolate => 1);
347 if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
348 $ctx->inject_if_block(
349 $ctx->scope_injector_call .
350 sprintf ';local %s = %s;',
357 $attrs->{Chained} = $target;
364 method _handle_chains_option (Object $ctx, HashRef $attrs) {
367 $ctx->strip_name eq 'to'
368 or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);
370 return $self->_handle_under_option($ctx, $attrs);
373 method _handle_as_option (Object $ctx, HashRef $attrs) {
377 my $path = $self->_strip_actionpath($ctx, interpolate => 1);
378 $attrs->{PathPart} = $path;
383 method _count_positional_arguments (Object $method) {
384 my $signature = $method->parsed_signature;
386 if ($signature->has_positional_params) {
387 my $count = @{ scalar($signature->positional_params) };
389 if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
399 method _inject_attributes (Object $ctx, HashRef $attrs) {
401 # attrs that need to be runtime-resolved
402 my @inject = qw( Chained PathPart Subname );
404 # turn specific attributes into a hashref
405 my $code = sprintf ' +{ %s }, sub ', # the ', sub ' turns method +{ ... } { ... } into
406 join ', ', # method +{ ... }, sub { ... }
408 map { defined( $_->[1] ) ? $_ : [$_->[0], 'undef'] }
409 map { [pp($_), $attrs->{ $_ }] }
410 grep { defined $attrs->{ $_ } }
413 # inject the hashref code before the action body
414 $ctx->inject_code_parts_here($code);
415 $ctx->inc_offset(length $code);
418 method _strip_actionpath (Object $ctx, :$interpolate?) {
421 my $linestr = $ctx->get_linestr;
422 my $rest = substr($linestr, $ctx->offset);
423 my $interp = sub { $interpolate ? "'$_[0]'" : $_[0] };
425 # find simple barewords
426 if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
427 substr($linestr, $ctx->offset, length($1)) = '';
428 $ctx->set_linestr($linestr);
429 return $interp->($1);
432 # allow single quoted more complex barewords
433 elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
434 substr($linestr, $ctx->offset, length($1) + 2) = '';
435 $ctx->set_linestr($linestr);
436 return $interp->($1);
439 # double quoted strings and variables
440 elsif ($interpolate and my $str = $ctx->get_string) {
444 # not suitable as action path
446 croak "Invalid syntax for action path: $rest";
450 # down here because it requires the parse method
451 with 'MooseX::Declare::Syntax::KeywordHandling';
453 around context_traits { $self->$orig, StringParsing }
460 CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
464 use CatalystX::Declare;
466 controller MyApp::Web::Controller::Example {
468 # chain base action with path part setting of ''
469 # body-less actions don't do anything by themselves
470 action base as '' under '/';
472 # simple end-point action
473 action controller_class is final under base {
474 $ctx->response->body( 'controller: ' . ref $self );
477 # chain part actions can have arguments
478 action str (Str $string) under base {
480 $ctx->stash(chars => [split //, $string]);
483 # and end point actions too, of course
484 action uc_chars (Int $count) under str is final {
486 my $chars = $ctx->stash->{chars};
491 # you can use a shortcut for multiple actions with
495 # this is an endpoint after base
496 action normal is final;
498 # the final keyword can be used to be more
499 # visually explicit about end-points
500 final action some_action { ... }
502 # type dispatching works
503 final action with_str (Str $x) as via_type;
504 final action with_int (Int $x) as via_type;
507 # of course you can also chain to external actions
508 final action some_end under '/some/controller/some/action';
513 This handler class provides the user with C<action>, C<final> and C<under>
514 keywords. There are multiple ways to define actions to allow for greater
515 freedom of expression. While the parts of the action declaration itself do
516 not care about their order, their syntax is rather strict.
518 You can choose to separate syntax elements via C<,> if you think it is more
519 readable. The action declaration
521 action foo is final under base;
523 is parsed in exactly the same way if you write it as
525 action foo, is final, under base;
527 =head2 Basic Action Declaration
529 The simplest possible declaration is
533 This would define a chain-part action chained to nothing with the name C<foo>
534 and no arguments. Since it isn't followed by a block, the body of the action
537 You will automatically be provided with two variables: C<$self> is, as you
538 might expect, your controller instance. C<$ctx> will be the Catalyst context
539 object. Thus, the following code would stash the value returned by the
543 $ctx->stash(item => $self->get_item);
546 =head2 Why $ctx instead of $c
548 Some might ask why the context object is called C<$ctx> instead of the usual
549 C<$c>. The reason is simple: It's an opinionated best practice, since C<$ctx>
552 =head2 Setting a Path Part
554 As usual with Catalyst actions, the path part (the public name of this part of
555 the URI, if you're not familiar with the term yet) will default to the name of
556 the action itself (or more correctly: to whatever Catalyst defaults).
558 To change that, use the C<as> option:
561 action base as ''; # <empty>
562 action something as 'foo/bar'; # foo/bar
563 action barely as bareword; # bareword
566 =head2 Chaining Actions
568 Currently, L<CatalystX::Declare> is completely based on the concept of
569 L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
570 chained or private. You can specify the action you want to chain to with the
573 action foo; # chained to nothing
574 action foo under '/'; # also chained to /
575 action foo under bar; # chained to the local bar action
576 action foo under '/bar/baz'; # chained to baz in /bar
578 C<under> is also provided as a grouping keyword. Every action inside the block
579 will be chained to the specified action:
586 You can also use the C<under> keyword for a single action. This is useful if
587 you want to highlight a single action with a significant diversion from what
590 action base under '/';
592 under '/the/sink' is final action foo;
594 final action bar under base;
596 final action baz under base;
598 Instead of the C<under> option declaration, you can also use a more english
599 variant named C<chains to>. While C<under> might be nice and concise, some
600 people might prefer this if they confuse C<under> with the specification of
601 a public path part. The argument to C<chains to> is the same as to C<under>:
603 action foo chains to bar;
604 action foo under bar;
606 By default all actions are chain-parts, not end-points. If you want an action
607 to be picked up as end-point and available via a public path, you have to say
608 so explicitely by using the C<is final> option:
610 action base under '/';
611 action foo under base is final; # /base/foo
613 You can also drop the C<is> part of the C<is final> option if you want:
615 under base, final action foo { ... }
617 You can make end-points more visually distinct by using the C<final> keyword
618 instead of the option:
620 action base under '/';
621 final action foo under base; # /base/foo
623 And of course, the C<final>, C<under> and C<action> keywords can be used in
624 combination whenever needed:
626 action base as '' under '/';
630 final action list; # /list
636 final action view; # /list/load/view
637 final action edit; # /list/load/edit
641 There is also one shorthand alternative for declaring chain targets. You can
642 specify an action after a C<E<lt>-> following the action name:
644 action base under '/';
645 final action foo <- base; # /base/foo
649 You can use signatures like you are use to from L<MooseX::Method::Signatures>
650 to declare action parameters. The number of positinoal arguments will be used
651 during dispatching as well as their types.
653 The signature follows the action name:
656 final action foo (Int $year, Int $month, Int $day);
658 If you are using the shorthand definition, the signature follows the chain
662 final action foo <- base ($x) under '/' { ... }
664 Parameters may be specified on chain-parts and end-points:
667 action base (Str $lang) under '/';
668 final action page (Int $page_num) under base;
670 Named parameters will be populated with the values in the query parameters:
673 final action view (Int $id, Int :$page = 1) under '/';
675 If you specify a query parameter to be an C<ArrayRef>, it will be specially
676 handled. For one, it will match even if there is no such value in the
677 parameters. Second, it will always be wrapped as an array reference.
679 Your end-points can also take an unspecified amount of arguments by specifying
680 an array as a variable:
682 # /find/some/deep/path/spec
683 final action find (@path) under '/';
687 The signatures are now validated during dispatching-time, and an action with
688 a non-matching signature (number of positional arguments and their types) will
689 not be dispatched to. This means that
691 action base under '/' as '';
695 final as double, action double_integer (Int $x) {
696 $ctx->response->body( $x * 2 );
699 final as double, action double_string (Str $x) {
700 $ctx->response->body( $x x 2 );
704 will return C<foofoo> when called as C</double/foo> and C<46> when called as
707 =head2 Actions and Method Modifiers
709 Method modifiers can not only be applied to methods, but also to actions. There
710 is no way yet to override the attributes of an already established action via
711 modifiers. However, you can modify the method underlying the action.
713 The following code is an example role modifying the consuming controller's
716 use CatalystX::Declare;
718 controller_role MyApp::Web::ControllerRole::RichBase {
720 before base (Object $ctx) {
721 $ctx->stash(something => $ctx->model('Item'));
725 Note that you have to specify the C<$ctx> argument yourself, since you are
726 modifying a method, not an action.
728 Any controller having a C<base> action (or method, for this purpose), can now
729 consume the C<RichBase> role declared above:
731 use CatalystX::Declare;
733 controller MyApp::Web::Controller::Foo
734 with MyApp::Web::Controller::RichBase {
736 action base as '' under '/';
738 action show, final under base {
739 $ctx->response->body(
740 $ctx->stash->{something}->render,
745 You can consume multiple action roles similarly to the way you do with the
746 class or role keyword:
755 with (LoggedIn, isSuperUser) {}
757 Lastly, you can pass parameters to the underlying L<Catalyst::Action> using
758 a syntax that is similar to method traits:
760 action myaction with hasRole(opt1=>'val1', opt2=>'val2')
762 Where C<%opts> is a hash that is used to populate $action->attributes in the
763 same way you might have done the following in classic L<Catalyst>
765 sub myaction :Action :Does(hasRole) :opt1(val1) :opt2(val2)
767 Here's a more detailed example:
770 with hasLogger(log_engine=>'STDOUT')
772 role=>['Administrator', 'Member'],
775 Think of these are classic catalyst subroutine attributes on steriods. Unlike
776 subroutine attributes, you can split and format your code across multiple lines
777 and you can use deep and complex data structures such as HashRefs or ArrayRefs.
778 Also, since the parameters are grouped syntactically within the C<with> keyword
779 this should improve readability of your code, since it will be more clear which
780 parameters belong to with roles. This should give L<CatalystX::Declare> greater
781 compatibility with legacy L<Catalyst> code but offer us a way forward from
782 needing subroutine attributes, which suffer from significant drawbacks.
784 A few caveats and differences from method traits. First of all, unlike method
785 traits, parameters are not passed to the L<Catalyst::Action> constructor, but
786 instead used to populate the C<attributes> attribute, which is to preserve
787 compatibility with how subroutine attributes work in classic L<Catalyst>.
789 Additionally, since subroutines attributes supported a very limited syntax for
790 supplying values, we follow the convention where parameter values are pushed
791 onto an arrayref. In other words the following:
793 action User with hasLogger(engine=>'STDOUT')
795 would create the following data structure:
797 $action->attributes->{engine} = ['STDOUT']
799 The one exception is that if the value is an arrayref, those will be merged:
801 action User with Permissions(roles=>[qw/admin member/]) {}
802 ## Creates: $action->attributes->{roles} = ['admin','member']
804 My feeling is that this gives better backward compatibility with classic sub
807 sub User :Action :Does(Permissions) :roles(admin) :roles(member)
809 However, I realize this method could lead to namespace collisions within the
810 C<$action->attributes> attribute. For now this is an avoidable issue. In the
811 future we may add a C<$action->trait_attributes> or similar attribute to the
812 L<Catalyst::Action> class in order to resolve this issue.
814 =head2 Action Classes
816 B<This option is even more experimental>
818 You might want to create an action with a different class than the usual
819 L<Catalyst::Action>. A usual suspect here is L<Catalyst::Action::RenderView>.
820 You can use the C<isa> option (did I mention it's experimental?) to specify
823 controller MyApp::Web::Controller::Root {
825 $CLASS->config(namespace => '');
827 action end isa RenderView;
830 The loaded class will be L<Moose>ified, so we are able to apply essential
833 =head2 Private Actions
835 B<This option is a bit less, but still pretty experimental>
837 You can declare private actions with the C<is private> trait:
839 action end is private isa RenderView;
845 =item L<MooseX::Declare::Syntax::KeywordHandling>
851 These methods are implementation details. Unless you are extending or
852 developing L<CatalystX::Declare>, you should not be concerned with them.
856 Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
858 A hook that will be invoked by L<MooseX::Declare> when this instance is called
859 to handle syntax. It will parse the action declaration, prepare attributes and
860 add the actions to the controller.
866 =item L<CatalystX::Declare>
868 =item L<CatalystX::Declare::Keyword::Controller>
870 =item L<MooseX::Method::Signatures>
876 See L<CatalystX::Declare/AUTHOR> for author information.
880 This program is free software; you can redistribute it and/or modify it under
881 the same terms as perl itself.