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 'MooseX::Method::Signatures::Meta::Method';
20 use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
23 method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
25 # somewhere to put the attributes
30 until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
35 if ($ctx->peek_next_char eq ',') {
37 my $linestr = $ctx->get_linestr;
38 substr($linestr, $ctx->offset, 1) = '';
39 $ctx->set_linestr($linestr);
44 # next thing should be an option name
49 $ctx->skip_declarator;
50 $skipped_declarator++;
53 or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);
55 # we need to be able to handle the rest
56 my $handler = $self->can("_handle_${option}_option")
57 or croak "Unknown action option: $option";
60 my $populator = $self->$handler($ctx, \%attributes);
62 if ($populator and $populator eq STOP_PARSING) {
64 return $ctx->shadow(sub (&) {
70 push @populators, $populator
71 if defined $populator;
74 croak "Need an action specification"
75 unless exists $attributes{Signature};
77 my $name = $attributes{Subname};
79 my $method = Method->wrap(
80 signature => qq{($attributes{Signature})},
81 package_name => $ctx->get_curstash_name,
85 AttributeRole->meta->apply($method);
90 unless ($attributes{Private}) {
91 $attributes{PathPart} ||= "'$name'";
93 delete $attributes{CaptureArgs}
94 if exists $attributes{Args};
96 $attributes{CaptureArgs} = 0
97 unless exists $attributes{Args}
98 or exists $attributes{CaptureArgs};
101 if ($attributes{Private}) {
102 delete $attributes{ $_ }
103 for qw( Args CaptureArgs Chained Signature Subname Action );
106 if ($ctx->peek_next_char eq '{') {
107 $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
110 $ctx->inject_code_parts_here(
112 $ctx->scope_injector_call,
113 $method->injectable_code,
117 my @attributes = map {
120 ref($attributes{ $_ }) eq 'ARRAY'
121 ? ( scalar(@{ $attributes{ $_ } })
122 ? sprintf('(%s)', join(' ', @{ $attributes{ $_ } }))
124 : "($attributes{ $_ })"
128 return $ctx->shadow(sub (&) {
132 $method->_set_actual_body($body);
133 $method->{attributes} = \@attributes;
137 add_method_modifier $class, $modifier, [$name, $method];
141 $class->meta->add_method($name, $method);
142 $class->meta->register_method_attributes($class->can($method->name), \@attributes);
147 method _handle_with_option (Object $ctx, HashRef $attrs) {
149 my $role = $ctx->strip_name
150 or croak "Expected bareword role specification for action after with";
152 # we need to fish for aliases here since we are still unclean
153 if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
157 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
162 method _handle_isa_option (Object $ctx, HashRef $attrs) {
164 my $class = $ctx->strip_name
165 or croak "Expected bareword action class specification for action after isa";
167 if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
171 $attrs->{CatalystX_Declarative_ActionClass} = $class;
176 method _check_for_available_import (Object $ctx, Str $name) {
178 if (my $code = $ctx->get_curstash_name->can($name)) {
185 method _handle_action_option (Object $ctx, HashRef $attrs) {
188 my $name = $ctx->strip_name
189 or croak "Anonymous actions not yet supported";
194 if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
195 my $linestr = $ctx->get_linestr;
196 substr($linestr, $ctx->offset, 2) = '';
197 $ctx->set_linestr($linestr);
198 $populator = $self->_handle_under_option($ctx, $attrs);
202 my $proto = $ctx->strip_proto || '';
203 $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
205 $attrs->{Subname} = $name;
206 $attrs->{Signature} = $proto;
207 $attrs->{Action} = [];
209 if (defined $CatalystX::Declare::SCOPE::UNDER) {
210 $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
213 return unless $populator;
217 method _handle_final_option (Object $ctx, HashRef $attrs) {
219 return $self->_build_flag_populator($ctx, $attrs, 'final');
222 method _handle_is_option (Object $ctx, HashRef $attrs) {
224 my $what = $ctx->strip_name
225 or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
227 return $self->_build_flag_populator($ctx, $attrs, $what);
230 method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
235 if ($what eq any qw( end endpoint final )) {
236 my $count = $self->_count_positional_arguments($method);
237 $attrs->{Args} = defined($count) ? $count : '';
239 elsif ($what eq 'private') {
240 $attrs->{Private} = [];
245 method _handle_under_option (Object $ctx, HashRef $attrs) {
247 my $target = $self->_strip_actionpath($ctx);
250 if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
251 $ctx->inject_if_block(
252 sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
253 $ctx->scope_injector_call,
261 $attrs->{Chained} = "'$target'";
266 my $count = $self->_count_positional_arguments($method);
267 $attrs->{CaptureArgs} = $count
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
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 C</> 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:
423 action base as ''; # <empty>
424 action something as 'foo/bar'; # foo/bar
425 action barely as bareword; # bareword
427 =head2 Chaining Actions
429 Currently, L<CatalystX::Declare> is completely based on the concept of
430 L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
431 chained to something. No base specification means you chain to the root. You
432 can specify the action you want to chain to with the C<under> option:
434 action foo; # chained to /
435 action foo under '/'; # also chained to /
436 action foo under bar; # chained to the local bar action
437 action foo under '/bar/baz'; # chained to baz in /bar
439 C<under> is also provided as a grouping keyword. Every action inside the block
440 will be chained to the specified action:
447 You can also use the C<under> keyword for a single action. This is useful if
448 you want to highlight a single action with a significant diversion from what
453 under '/the/sink' is final action foo;
455 final action bar under base;
457 final action baz under base;
459 Instead of the C<under> option declaration, you can also use a more english
460 variant named C<chains to>. While C<under> might be nice and concise, some
461 people might prefer this if they confuse C<under> with the specification of
462 a public path part. The argument to C<chains to> is the same as to C<under>:
464 action foo chains to bar;
465 action foo under bar;
467 By default all actions are chain-parts, not end-points. If you want an action
468 to be picked up as end-point and available via a public path, you have to say
469 so explicitely by using the C<is final> option:
472 action foo under base is final; # /base/foo
474 You can also drop the C<is> part of the C<is final> option if you want:
476 under base, final action foo { ... }
478 You can make end-points more visually distinct by using the C<final> keyword
479 instead of the option:
482 final action foo under base; # /base/foo
484 And of course, the C<final>, C<under> and C<action> keywords can be used in
485 combination whenever needed:
491 final action list; # /list
497 final action view; # /list/load/view
498 final action edit; # /list/load/edit
502 There is also one shorthand alternative for declaring chain targets. You can
503 specify an action after a C<E<lt>-> following the action name:
506 final action foo <- base; # /base/foo
510 You can use signatures like you are use to from L<MooseX::Method::Signatures>
511 to declare action parameters. The number of arguments will be used during
512 dispatching. Dispatching by type constraint is planned but not yet implemented.
514 The signature follows the action name:
517 final action foo (Int $year, Int $month, Int $day);
519 If you are using the shorthand definition, the signature follows the chain
523 final action foo <- base ($x) { ... }
525 Parameters may be specified on chain-parts and end-points:
528 action base (Str $lang);
529 final action page (Int $page_num) under base;
531 Named parameters will be populated with the values in the query parameters:
534 final action view (Int $id, Int :$page = 1);
536 Your end-points can also take an unspecified amount of arguments by specifying
537 an array as a variable:
539 # /find/some/deep/path/spec
540 final action find (@path);
542 =head2 Actions and Method Modifiers
544 Method modifiers can not only be applied to methods, but also to actions. There
545 is no way yet to override the attributes of an already established action via
546 modifiers. However, you can modify the method underlying the action.
548 The following code is an example role modifying the consuming controller's
551 use CatalystX::Declare;
553 controller_role MyApp::Web::ControllerRole::RichBase {
555 before base (Object $ctx) {
556 $ctx->stash(something => $ctx->model('Item'));
560 Note that you have to specify the C<$ctx> argument yourself, since you are
561 modifying a method, not an action.
563 Any controller having a C<base> action (or method, for this purpose), can now
564 consume the C<RichBase> role declared above:
566 use CatalystX::Declare;
568 controller MyApp::Web::Controller::Foo
569 with MyApp::Web::Controller::RichBase {
573 action show, final under base {
574 $ctx->response->body(
575 $ctx->stash->{something}->render,
584 =item L<MooseX::Declare::Syntax::KeywordHandling>
590 These methods are implementation details. Unless you are extending or
591 developing L<CatalystX::Declare>, you should not be concerned with them.
595 Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
597 A hook that will be invoked by L<MooseX::Declare> when this instance is called
598 to handle syntax. It will parse the action declaration, prepare attributes and
599 add the actions to the controller.
605 =item L<CatalystX::Declare>
607 =item L<CatalystX::Declare::Keyword::Controller>
609 =item L<MooseX::Method::Signatures>
615 See L<CatalystX::Declare/AUTHOR> for author information.
619 This program is free software; you can redistribute it and/or modify it under
620 the same terms as perl itself.