validation docs were in wrong order
[catagits/CatalystX-Declare.git] / lib / CatalystX / Declare / Keyword / Action.pm
CommitLineData
918fb36e 1use MooseX::Declare;
c2a8165b 2use MooseX::Role::Parameterized ();
918fb36e 3
9c11a562 4class CatalystX::Declare::Keyword::Action
918fb36e 5 with MooseX::Declare::Syntax::KeywordHandling {
6
7
a1dd1788 8 use Carp qw( croak );
9 use Perl6::Junction qw( any );
10 use Data::Dump qw( pp );
11 use MooseX::Types::Util qw( has_available_type_export );
c2a8165b 12 use Moose::Util qw( add_method_modifier ensure_all_roles );
a1dd1788 13 use Class::Inspector;
14 use Class::MOP;
15
918fb36e 16
e10b92dd 17 use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
9c11a562 18 use constant UNDER_VAR => '$CatalystX::Declare::SCOPE::UNDER';
fe864e80 19 use constant UNDER_STACK => '@CatalystX::Declare::SCOPE::UNDER_STACK';
e10b92dd 20
5fb5cef1 21 use aliased 'CatalystX::Declare::Action::CatchValidationError';
918fb36e 22 use aliased 'MooseX::Method::Signatures::Meta::Method';
23 use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
c2a8165b 24 use aliased 'MooseX::MethodAttributes::Role::Meta::Role', 'AttributeMetaRole';
918fb36e 25
26
856ac9a7 27 method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
918fb36e 28
29 # somewhere to put the attributes
30 my %attributes;
31 my @populators;
918fb36e 32
33 # parse declarations
34 until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
918fb36e 35
36 $ctx->skipspace;
37
38 # optional commas
39 if ($ctx->peek_next_char eq ',') {
40
41 my $linestr = $ctx->get_linestr;
42 substr($linestr, $ctx->offset, 1) = '';
43 $ctx->set_linestr($linestr);
44
45 next;
46 }
47
48 # next thing should be an option name
49 my $option = (
50 $skipped_declarator
51 ? $ctx->strip_name
52 : do {
53 $ctx->skip_declarator;
54 $skipped_declarator++;
55 $ctx->declarator;
56 })
57 or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);
58
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";
62
63 # call the handler
e10b92dd 64 my $populator = $self->$handler($ctx, \%attributes);
65
66 if ($populator and $populator eq STOP_PARSING) {
67
68 return $ctx->shadow(sub (&) {
69 my ($body) = @_;
70 return $body->();
71 });
72 }
73
74 push @populators, $populator
75 if defined $populator;
918fb36e 76 }
77
78 croak "Need an action specification"
79 unless exists $attributes{Signature};
80
81 my $name = $attributes{Subname};
856ac9a7 82
918fb36e 83 my $method = Method->wrap(
84 signature => qq{($attributes{Signature})},
85 package_name => $ctx->get_curstash_name,
86 name => $name,
87 );
88
a1dd1788 89 AttributeRole->meta->apply($method);
90
eb97acbb 91 my $count = $self->_count_positional_arguments($method);
92 $attributes{CaptureArgs} = $count
93 if defined $count;
94
918fb36e 95 $_->($method)
96 for @populators;
97
aae7ad1f 98 unless ($attributes{Private}) {
99 $attributes{PathPart} ||= "'$name'";
918fb36e 100
aae7ad1f 101 delete $attributes{CaptureArgs}
102 if exists $attributes{Args};
918fb36e 103
aae7ad1f 104 $attributes{CaptureArgs} = 0
105 unless exists $attributes{Args}
106 or exists $attributes{CaptureArgs};
107 }
108
109 if ($attributes{Private}) {
aae7ad1f 110 delete $attributes{ $_ }
ed4a2203 111 for qw( Args CaptureArgs Chained Signature Private );
aae7ad1f 112 }
918fb36e 113
114 if ($ctx->peek_next_char eq '{') {
115 $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
116 }
117 else {
118 $ctx->inject_code_parts_here(
119 sprintf '{ %s%s }',
120 $ctx->scope_injector_call,
121 $method->injectable_code,
122 );
123 }
124
5fb5cef1 125 my @attributes;
126 for my $attr (keys %attributes) {
127 push @attributes,
eb97acbb 128 map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
5fb5cef1 129 (ref($attributes{ $attr }) eq 'ARRAY')
130 ? @{ $attributes{ $attr } }
131 : $attributes{ $attr };
132 }
918fb36e 133
134 return $ctx->shadow(sub (&) {
135 my $class = caller;
856ac9a7 136 my $body = shift;
918fb36e 137
856ac9a7 138 $method->_set_actual_body($body);
918fb36e 139 $method->{attributes} = \@attributes;
856ac9a7 140
141 if ($modifier) {
142
143 add_method_modifier $class, $modifier, [$name, $method];
144 }
145 else {
146
c2a8165b 147 my $prepare_meta = sub {
148 my ($meta) = @_;
149
150 $meta->add_method($name, $method);
151 $meta->register_method_attributes($meta->name->can($method->name), \@attributes);
152 };
153
154 if ($ctx->stack->[-1] and $ctx->stack->[-1]->is_parameterized) {
155 my $real_meta = MooseX::Role::Parameterized->current_metaclass;
156
157 $real_meta->meta->make_mutable
158 if $real_meta->meta->is_immutable;
159 ensure_all_roles $real_meta->meta, AttributeMetaRole
160 if $real_meta->isa('Moose::Meta::Role');
161
162 $real_meta->$prepare_meta;
163 }
164
165 $class->meta->$prepare_meta;
856ac9a7 166 }
918fb36e 167 });
168 }
169
a1dd1788 170 method _handle_with_option (Object $ctx, HashRef $attrs) {
171
172 my $role = $ctx->strip_name
173 or croak "Expected bareword role specification for action after with";
174
175 # we need to fish for aliases here since we are still unclean
176 if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
177 $role = $alias;
178 }
179
180 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
181
182 return;
183 }
184
185 method _handle_isa_option (Object $ctx, HashRef $attrs) {
186
187 my $class = $ctx->strip_name
188 or croak "Expected bareword action class specification for action after isa";
189
190 if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
191 $class = $alias;
192 }
193
194 $attrs->{CatalystX_Declarative_ActionClass} = $class;
195
196 return;
197 }
198
199 method _check_for_available_import (Object $ctx, Str $name) {
200
201 if (my $code = $ctx->get_curstash_name->can($name)) {
202 return $code->();
203 }
204
205 return undef;
206 }
207
918fb36e 208 method _handle_action_option (Object $ctx, HashRef $attrs) {
209
210 # action name
211 my $name = $ctx->strip_name
212 or croak "Anonymous actions not yet supported";
213
64baeca0 214 $ctx->skipspace;
215 my $populator;
216
217 if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
218 my $linestr = $ctx->get_linestr;
219 substr($linestr, $ctx->offset, 2) = '';
220 $ctx->set_linestr($linestr);
221 $populator = $self->_handle_under_option($ctx, $attrs);
222 }
223
918fb36e 224 # signature
225 my $proto = $ctx->strip_proto || '';
226 $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
227
228 $attrs->{Subname} = $name;
229 $attrs->{Signature} = $proto;
aae7ad1f 230 $attrs->{Action} = [];
918fb36e 231
5fb5cef1 232 push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
233
9c11a562 234 if (defined $CatalystX::Declare::SCOPE::UNDER) {
235 $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
e10b92dd 236 }
237
64baeca0 238 return unless $populator;
239 return $populator;
918fb36e 240 }
241
2dde75e7 242 method _handle_final_option (Object $ctx, HashRef $attrs) {
243
244 return $self->_build_flag_populator($ctx, $attrs, 'final');
245 }
246
918fb36e 247 method _handle_is_option (Object $ctx, HashRef $attrs) {
248
249 my $what = $ctx->strip_name
250 or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
251
2dde75e7 252 return $self->_build_flag_populator($ctx, $attrs, $what);
253 }
254
255 method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
256
918fb36e 257 return sub {
258 my $method = shift;
259
260 if ($what eq any qw( end endpoint final )) {
eb97acbb 261 $attrs->{Args} = delete $attrs->{CaptureArgs};
918fb36e 262 }
263 elsif ($what eq 'private') {
aae7ad1f 264 $attrs->{Private} = [];
918fb36e 265 }
266 };
267 }
268
269 method _handle_under_option (Object $ctx, HashRef $attrs) {
270
271 my $target = $self->_strip_actionpath($ctx);
e10b92dd 272 $ctx->skipspace;
273
274 if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
275 $ctx->inject_if_block(
fe864e80 276 sprintf '%s; BEGIN { push %s, %s; %s = qq(%s) };',
277 $ctx->scope_injector_call(
278 sprintf ';BEGIN { %s = pop %s };',
279 UNDER_VAR,
280 UNDER_STACK,
281 ),
282 UNDER_STACK,
e10b92dd 283 UNDER_VAR,
284 UNDER_VAR,
285 $target,
286 );
287 return STOP_PARSING;
288 }
289
918fb36e 290 $attrs->{Chained} = "'$target'";
291
292 return sub {
293 my $method = shift;
918fb36e 294 };
295 }
296
297 method _handle_chains_option (Object $ctx, HashRef $attrs) {
298
299 $ctx->skipspace;
300 $ctx->strip_name eq 'to'
301 or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);
302
303 return $self->_handle_under_option($ctx, $attrs);
304 }
305
306 method _handle_as_option (Object $ctx, HashRef $attrs) {
307
308 $ctx->skipspace;
309
310 my $path = $self->_strip_actionpath($ctx);
311 $attrs->{PathPart} = "'$path'";
312
313 return;
314 }
315
316 method _count_positional_arguments (Object $method) {
c2a8165b 317 my $signature = $method->parsed_signature;
918fb36e 318
319 if ($signature->has_positional_params) {
320 my $count = @{ scalar($signature->positional_params) };
321
322 if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
323 return undef;
324 }
325
326 return $count - 1;
327 }
328
329 return 0;
330 }
331
332 method _strip_actionpath (Object $ctx) {
333
334 $ctx->skipspace;
335 my $linestr = $ctx->get_linestr;
336 my $rest = substr($linestr, $ctx->offset);
337
338 if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
339 substr($linestr, $ctx->offset, length($1)) = '';
340 $ctx->set_linestr($linestr);
341 return $1;
342 }
a0ebba1d 343 elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
918fb36e 344 substr($linestr, $ctx->offset, length($1) + 2) = '';
345 $ctx->set_linestr($linestr);
346 return $1;
347 }
348 else {
349 croak "Invalid syntax for action path: $rest";
350 }
351 }
352}
353
856ac9a7 354__END__
355
356=head1 NAME
357
358CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
359
360=head1 SYNOPSIS
361
362 use CatalystX::Declare;
363
364 controller MyApp::Web::Controller::Example {
365
366 # chain base action with path part setting of ''
367 # body-less actions don't do anything by themselves
6e2492a4 368 action base as '' under '/';
856ac9a7 369
370 # simple end-point action
371 action controller_class is final under base {
372 $ctx->response->body( 'controller: ' . ref $self );
373 }
374
375 # chain part actions can have arguments
376 action str (Str $string) under base {
377
378 $ctx->stash(chars => [split //, $string]);
379 }
380
381 # and end point actions too, of course
382 action uc_chars (Int $count) under str is final {
383
384 my $chars = $ctx->stash->{chars};
385 ...
386 }
387
388
389 # you can use a shortcut for multiple actions with
390 # a common base
391 under base {
392
393 # this is an endpoint after base
394 action normal is final;
395
396 # the final keyword can be used to be more
397 # visually explicit about end-points
398 final action some_action { ... }
ed4a2203 399
400 # type dispatching works
401 final action with_str (Str $x) as via_type;
402 final action with_int (Int $x) as via_type;
856ac9a7 403 }
404
405 # of course you can also chain to external actions
406 final action some_end under '/some/controller/some/action';
407 }
408
409=head1 DESCRIPTION
410
411This handler class provides the user with C<action>, C<final> and C<under>
412keywords. There are multiple ways to define actions to allow for greater
413freedom of expression. While the parts of the action declaration itself do
414not care about their order, their syntax is rather strict.
415
416You can choose to separate syntax elements via C<,> if you think it is more
417readable. The action declaration
418
419 action foo is final under base;
420
421is parsed in exactly the same way if you write it as
422
423 action foo, is final, under base;
424
425=head2 Basic Action Declaration
426
427The simplest possible declaration is
428
429 action foo;
430
6e2492a4 431This would define a chain-part action chained to nothing with the name C<foo>
856ac9a7 432and no arguments. Since it isn't followed by a block, the body of the action
433will be empty.
434
435You will automatically be provided with two variables: C<$self> is, as you
436might expect, your controller instance. C<$ctx> will be the Catalyst context
437object. Thus, the following code would stash the value returned by the
438C<get_item> method:
439
440 action foo {
441 $ctx->stash(item => $self->get_item);
442 }
443
32663314 444=head2 Why $ctx instead of $c
445
446Some might ask why the context object is called C<$ctx> instead of the usual
447C<$c>. The reason is simple: It's an opinionated best practice, since C<$ctx>
448stands out more.
449
856ac9a7 450=head2 Setting a Path Part
451
452As usual with Catalyst actions, the path part (the public name of this part of
453the URI, if you're not familiar with the term yet) will default to the name of
454the action itself (or more correctly: to whatever Catalyst defaults).
455
456To change that, use the C<as> option:
457
6e2492a4 458 under something {
459 action base as ''; # <empty>
460 action something as 'foo/bar'; # foo/bar
461 action barely as bareword; # bareword
462 }
856ac9a7 463
464=head2 Chaining Actions
465
466Currently, L<CatalystX::Declare> is completely based on the concept of
467L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
6e2492a4 468chained or private. You can specify the action you want to chain to with the
469C<under> option:
856ac9a7 470
6e2492a4 471 action foo; # chained to nothing
856ac9a7 472 action foo under '/'; # also chained to /
473 action foo under bar; # chained to the local bar action
474 action foo under '/bar/baz'; # chained to baz in /bar
475
476C<under> is also provided as a grouping keyword. Every action inside the block
477will be chained to the specified action:
478
479 under base {
480 action foo { ... }
481 action bar { ... }
482 }
483
484You can also use the C<under> keyword for a single action. This is useful if
485you want to highlight a single action with a significant diversion from what
486is to be expected:
487
6e2492a4 488 action base under '/';
856ac9a7 489
490 under '/the/sink' is final action foo;
491
492 final action bar under base;
493
494 final action baz under base;
495
496Instead of the C<under> option declaration, you can also use a more english
497variant named C<chains to>. While C<under> might be nice and concise, some
498people might prefer this if they confuse C<under> with the specification of
499a public path part. The argument to C<chains to> is the same as to C<under>:
500
501 action foo chains to bar;
502 action foo under bar;
503
504By default all actions are chain-parts, not end-points. If you want an action
505to be picked up as end-point and available via a public path, you have to say
506so explicitely by using the C<is final> option:
507
6e2492a4 508 action base under '/';
856ac9a7 509 action foo under base is final; # /base/foo
510
511You can also drop the C<is> part of the C<is final> option if you want:
512
513 under base, final action foo { ... }
514
515You can make end-points more visually distinct by using the C<final> keyword
516instead of the option:
517
6e2492a4 518 action base under '/';
856ac9a7 519 final action foo under base; # /base/foo
520
521And of course, the C<final>, C<under> and C<action> keywords can be used in
522combination whenever needed:
523
6e2492a4 524 action base as '' under '/';
856ac9a7 525
526 under base {
527
528 final action list; # /list
529
530 action load;
531
532 under load {
533
534 final action view; # /list/load/view
535 final action edit; # /list/load/edit
536 }
537 }
538
539There is also one shorthand alternative for declaring chain targets. You can
540specify an action after a C<E<lt>-> following the action name:
541
6e2492a4 542 action base under '/';
856ac9a7 543 final action foo <- base; # /base/foo
544
545=head2 Arguments
546
547You can use signatures like you are use to from L<MooseX::Method::Signatures>
ed4a2203 548to declare action parameters. The number of positinoal arguments will be used
549during dispatching as well as their types.
856ac9a7 550
551The signature follows the action name:
552
553 # /foo/*/*/*
554 final action foo (Int $year, Int $month, Int $day);
555
556If you are using the shorthand definition, the signature follows the chain
557target:
558
559 # /foo/*
6e2492a4 560 final action foo <- base ($x) under '/' { ... }
856ac9a7 561
562Parameters may be specified on chain-parts and end-points:
563
564 # /base/*/foo/*
6e2492a4 565 action base (Str $lang) under '/';
856ac9a7 566 final action page (Int $page_num) under base;
567
568Named parameters will be populated with the values in the query parameters:
569
570 # /view/17/?page=3
6e2492a4 571 final action view (Int $id, Int :$page = 1) under '/';
856ac9a7 572
573Your end-points can also take an unspecified amount of arguments by specifying
574an array as a variable:
575
576 # /find/some/deep/path/spec
6e2492a4 577 final action find (@path) under '/';
856ac9a7 578
5fb5cef1 579=head2 Validation
580
ed4a2203 581The signatures are now validated during dispatching-time, and an action with
582a non-matching signature (number of positional arguments and their types) will
583not be dispatched to. This means that
584
585 action base under '/' as '';
586
587 under base {
588
ed4a2203 589 final as double, action double_integer (Int $x) {
590 $ctx->response->body( $x * 2 );
591 }
aee1c364 592
593 final as double, action double_string (Str $x) {
594 $ctx->response->body( $x x 2 );
595 }
ed4a2203 596 }
597
598will return C<foofoo> when called as C</double/foo> and C<46> when called as
599C</double/23>.
5fb5cef1 600
856ac9a7 601=head2 Actions and Method Modifiers
602
603Method modifiers can not only be applied to methods, but also to actions. There
604is no way yet to override the attributes of an already established action via
605modifiers. However, you can modify the method underlying the action.
606
607The following code is an example role modifying the consuming controller's
608C<base> action:
609
610 use CatalystX::Declare;
611
205323ac 612 controller_role MyApp::Web::ControllerRole::RichBase {
856ac9a7 613
614 before base (Object $ctx) {
615 $ctx->stash(something => $ctx->model('Item'));
616 }
617 }
618
619Note that you have to specify the C<$ctx> argument yourself, since you are
620modifying a method, not an action.
621
622Any controller having a C<base> action (or method, for this purpose), can now
623consume the C<RichBase> role declared above:
624
625 use CatalystX::Declare;
626
627 controller MyApp::Web::Controller::Foo
628 with MyApp::Web::Controller::RichBase {
629
6e2492a4 630 action base as '' under '/';
856ac9a7 631
632 action show, final under base {
633 $ctx->response->body(
634 $ctx->stash->{something}->render,
635 );
636 }
637 }
638
2bb54af3 639=head2 Action Classes
640
641B<This option is even more experimental>
642
643You might want to create an action with a different class than the usual
644L<Catalyst::Action>. A usual suspect here is L<Catalyst::Action::RenderView>.
645You can use the C<isa> option (did I mention it's experimental?) to specify
646what class to use:
647
648 controller MyApp::Web::Controller::Root {
649
650 $CLASS->config(namespace => '');
651
652 action end isa RenderView;
653 }
654
655The loaded class will be L<Moose>ified, so we are able to apply essential
656roles.
657
856ac9a7 658=head1 ROLES
659
660=over
661
662=item L<MooseX::Declare::Syntax::KeywordHandling>
663
664=back
665
666=head1 METHODS
667
668These methods are implementation details. Unless you are extending or
669developing L<CatalystX::Declare>, you should not be concerned with them.
670
671=head2 parse
672
673 Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
674
675A hook that will be invoked by L<MooseX::Declare> when this instance is called
676to handle syntax. It will parse the action declaration, prepare attributes and
677add the actions to the controller.
678
679=head1 SEE ALSO
680
681=over
682
683=item L<CatalystX::Declare>
684
685=item L<CatalystX::Declare::Keyword::Controller>
686
687=item L<MooseX::Method::Signatures>
688
689=back
690
691=head1 AUTHOR
692
693See L<CatalystX::Declare/AUTHOR> for author information.
694
695=head1 LICENSE
696
697This program is free software; you can redistribute it and/or modify it under
698the same terms as perl itself.
918fb36e 699
856ac9a7 700=cut
918fb36e 701