[catagits/CatalystX-Declare.git] / lib / CatalystX / Declare / Keyword / Action.pm

use MooseX::Declare;

class CatalystX::Declare::Keyword::Action
    with MooseX::Declare::Syntax::KeywordHandling {


    use Carp                qw( croak );
    use Perl6::Junction     qw( any );
    use Data::Dump          qw( pp );
    use MooseX::Types::Util qw( has_available_type_export );
    use Moose::Util         qw( add_method_modifier );
    use Class::Inspector;
    use Class::MOP;


    use constant STOP_PARSING   => '__MXDECLARE_STOP_PARSING__';
    use constant UNDER_VAR      => '$CatalystX::Declare::SCOPE::UNDER';

    use aliased 'MooseX::Method::Signatures::Meta::Method';
    use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';


    method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {

        # somewhere to put the attributes
        my %attributes;
        my @populators;

        # parse declarations
        until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {

            $ctx->skipspace;
            
            # optional commas
            if ($ctx->peek_next_char eq ',') {

                my $linestr = $ctx->get_linestr;
                substr($linestr, $ctx->offset, 1) = '';
                $ctx->set_linestr($linestr);

                next;
            }

            # next thing should be an option name
            my $option = (
                $skipped_declarator 
                ? $ctx->strip_name 
                : do { 
                    $ctx->skip_declarator; 
                    $skipped_declarator++;
                    $ctx->declarator;
                })
              or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);

            # we need to be able to handle the rest
            my $handler = $self->can("_handle_${option}_option")
                or croak "Unknown action option: $option";

            # call the handler
            my $populator = $self->$handler($ctx, \%attributes);

            if ($populator and $populator eq STOP_PARSING) {

                return $ctx->shadow(sub (&) {
                    my ($body) = @_;
                    return $body->();
                });
            }

            push @populators, $populator
                if defined $populator;
        }

        croak "Need an action specification"
            unless exists $attributes{Signature};

        my $name   = $attributes{Subname};

        my $method = Method->wrap(
            signature       => qq{($attributes{Signature})},
            package_name    => $ctx->get_curstash_name,
            name            => $name,
        );

        AttributeRole->meta->apply($method);

        $_->($method)
            for @populators;

        unless ($attributes{Private}) {
            $attributes{PathPart} ||= "'$name'";

            delete $attributes{CaptureArgs}
                if exists $attributes{Args};

            $attributes{CaptureArgs} = 0
                unless exists $attributes{Args}
                    or exists $attributes{CaptureArgs};
        }

        if ($attributes{Private}) {
            delete $attributes{ $_ }
                for qw( Args CaptureArgs Chained Signature Subname Action );
        }

        if ($ctx->peek_next_char eq '{') {
            $ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
        }
        else {
            $ctx->inject_code_parts_here(
                sprintf '{ %s%s }',
                    $ctx->scope_injector_call,
                    $method->injectable_code,
            );
        }

        my @attributes = map { 
            join('',
                $_,
                ref($attributes{ $_ }) eq 'ARRAY'
                ? ( scalar(@{ $attributes{ $_ } })
                    ? sprintf('(%s)', join(' ', @{ $attributes{ $_ } }))
                    : '' )
                : "($attributes{ $_ })"
            );
        } keys %attributes;

        return $ctx->shadow(sub (&) {
            my $class = caller;
            my $body  = shift;

            $method->_set_actual_body($body);
            $method->{attributes} = \@attributes;

            if ($modifier) {

                add_method_modifier $class, $modifier, [$name, $method];
            }
            else {

                $class->meta->add_method($name, $method);
                $class->meta->register_method_attributes($class->can($method->name), \@attributes);
            }
        });
    }

    method _handle_with_option (Object $ctx, HashRef $attrs) {

        my $role = $ctx->strip_name
            or croak "Expected bareword role specification for action after with";

        # we need to fish for aliases here since we are still unclean
        if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
            $role = $alias;
        }

        push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;

        return;
    }

    method _handle_isa_option (Object $ctx, HashRef $attrs) {

        my $class = $ctx->strip_name
            or croak "Expected bareword action class specification for action after isa";

        if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
            $class = $alias;
        }

        $attrs->{CatalystX_Declarative_ActionClass} = $class;

        return;
    }

    method _check_for_available_import (Object $ctx, Str $name) {

        if (my $code = $ctx->get_curstash_name->can($name)) {
            return $code->();
        }

        return undef;
    }

    method _handle_action_option (Object $ctx, HashRef $attrs) {

        # action name
        my $name = $ctx->strip_name
            or croak "Anonymous actions not yet supported";

        $ctx->skipspace;
        my $populator;

        if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
            my $linestr = $ctx->get_linestr;
            substr($linestr, $ctx->offset, 2) = '';
            $ctx->set_linestr($linestr);
            $populator = $self->_handle_under_option($ctx, $attrs);
        }

        # signature
        my $proto = $ctx->strip_proto || '';
        $proto = join(', ', 'Object $self: Object $ctx', $proto || ());

        $attrs->{Subname}   = $name;
        $attrs->{Signature} = $proto;
        $attrs->{Action}    = [];

        if (defined $CatalystX::Declare::SCOPE::UNDER) {
            $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
        }

        return unless $populator;
        return $populator;
    }

    method _handle_final_option (Object $ctx, HashRef $attrs) {

        return $self->_build_flag_populator($ctx, $attrs, 'final');
    }

    method _handle_is_option (Object $ctx, HashRef $attrs) {

        my $what = $ctx->strip_name
            or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);

        return $self->_build_flag_populator($ctx, $attrs, $what);
    }

    method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {

        return sub {
            my $method = shift;

            if ($what eq any qw( end endpoint final )) {
                my $count = $self->_count_positional_arguments($method);
                $attrs->{Args} = defined($count) ? $count : '';
            }
            elsif ($what eq 'private') {
                $attrs->{Private} = [];
            }
        };
    }

    method _handle_under_option (Object $ctx, HashRef $attrs) {

        my $target = $self->_strip_actionpath($ctx);
        $ctx->skipspace;

        if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
            $ctx->inject_if_block(
                sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
                    $ctx->scope_injector_call,
                    UNDER_VAR,
                    UNDER_VAR,
                    $target,
            );
            return STOP_PARSING;
        }

        $attrs->{Chained} = "'$target'";

        return sub {
            my $method = shift;

            my $count = $self->_count_positional_arguments($method);
            $attrs->{CaptureArgs} = $count
                if defined $count;
        };
    }

    method _handle_chains_option (Object $ctx, HashRef $attrs) {

        $ctx->skipspace;
        $ctx->strip_name eq 'to'
            or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);

        return $self->_handle_under_option($ctx, $attrs);
    }

    method _handle_as_option (Object $ctx, HashRef $attrs) {

        $ctx->skipspace;

        my $path = $self->_strip_actionpath($ctx);
        $attrs->{PathPart} = "'$path'";

        return;
    }

    method _count_positional_arguments (Object $method) {
        my $signature = $method->_parsed_signature;

        if ($signature->has_positional_params) {
            my $count = @{ scalar($signature->positional_params) };

            if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
                return undef;
            }

            return $count - 1;
        }

        return 0;
    }

    method _strip_actionpath (Object $ctx) {

        $ctx->skipspace;
        my $linestr = $ctx->get_linestr;
        my $rest    = substr($linestr, $ctx->offset);

        if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
            substr($linestr, $ctx->offset, length($1)) = '';
            $ctx->set_linestr($linestr);
            return $1;
        }
        elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
            substr($linestr, $ctx->offset, length($1) + 2) = '';
            $ctx->set_linestr($linestr);
            return $1;
        }
        else {
            croak "Invalid syntax for action path: $rest";
        }
    }
}

__END__

=head1 NAME

CatalystX::Declare::Keyword::Action - Declare Catalyst Actions

=head1 SYNOPSIS

    use CatalystX::Declare;

    controller MyApp::Web::Controller::Example {

        # chain base action with path part setting of ''
        # body-less actions don't do anything by themselves
        action base as '' under '/';

        # simple end-point action
        action controller_class is final under base {
            $ctx->response->body( 'controller: ' . ref $self );
        }

        # chain part actions can have arguments
        action str (Str $string) under base {

            $ctx->stash(chars => [split //, $string]);
        }

        # and end point actions too, of course
        action uc_chars (Int $count) under str is final {
    
            my $chars = $ctx->stash->{chars};
            ...
        }


        # you can use a shortcut for multiple actions with
        # a common base
        under base {

            # this is an endpoint after base
            action normal is final;

            # the final keyword can be used to be more 
            # visually explicit about end-points
            final action some_action { ... }
        }

        # of course you can also chain to external actions
        final action some_end under '/some/controller/some/action';
    }

=head1 DESCRIPTION

This handler class provides the user with C<action>, C<final> and C<under> 
keywords. There are multiple ways to define actions to allow for greater
freedom of expression. While the parts of the action declaration itself do
not care about their order, their syntax is rather strict.

You can choose to separate syntax elements via C<,> if you think it is more
readable. The action declaration

    action foo is final under base;

is parsed in exactly the same way if you write it as

    action foo, is final, under base;

=head2 Basic Action Declaration

The simplest possible declaration is

    action foo;

This would define a chain-part action chained to nothing with the name C<foo>
and no arguments. Since it isn't followed by a block, the body of the action
will be empty.

You will automatically be provided with two variables: C<$self> is, as you
might expect, your controller instance. C<$ctx> will be the Catalyst context
object. Thus, the following code would stash the value returned by the 
C<get_item> method:

    action foo {
        $ctx->stash(item => $self->get_item);
    }

=head2 Setting a Path Part

As usual with Catalyst actions, the path part (the public name of this part of
the URI, if you're not familiar with the term yet) will default to the name of
the action itself (or more correctly: to whatever Catalyst defaults).

To change that, use the C<as> option:

    under something {
        action base      as '';             # <empty>
        action something as 'foo/bar';      # foo/bar
        action barely    as bareword;       # bareword
    }

=head2 Chaining Actions

Currently, L<CatalystX::Declare> is completely based on the concept of
L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
chained or private. You can specify the action you want to chain to with the 
C<under> option:

    action foo;                     # chained to nothing
    action foo under '/';           # also chained to /
    action foo under bar;           # chained to the local bar action
    action foo under '/bar/baz';    # chained to baz in /bar

C<under> is also provided as a grouping keyword. Every action inside the block
will be chained to the specified action:

    under base {
        action foo { ... }
        action bar { ... }
    }

You can also use the C<under> keyword for a single action. This is useful if
you want to highlight a single action with a significant diversion from what
is to be expected:

    action base under '/';

    under '/the/sink' is final action foo;

    final action bar under base;

    final action baz under base;

Instead of the C<under> option declaration, you can also use a more english
variant named C<chains to>. While C<under> might be nice and concise, some
people might prefer this if they confuse C<under> with the specification of
a public path part. The argument to C<chains to> is the same as to C<under>:

    action foo chains to bar;
    action foo under bar;

By default all actions are chain-parts, not end-points. If you want an action 
to be picked up as end-point and available via a public path, you have to say
so explicitely by  using the C<is final> option:

    action base under '/';
    action foo under base is final;   # /base/foo

You can also drop the C<is> part of the C<is final> option if you want:

    under base, final action foo { ... }

You can make end-points more visually distinct by using the C<final> keyword
instead of the option:

    action base under '/';
    final action foo under base;      # /base/foo

And of course, the C<final>, C<under> and C<action> keywords can be used in
combination whenever needed:

    action base as '' under '/';

    under base {

        final action list;          # /list

        action load;

        under load {

            final action view;      # /list/load/view
            final action edit;      # /list/load/edit
        }
    }

There is also one shorthand alternative for declaring chain targets. You can
specify an action after a C<E<lt>-> following the action name:

    action base under '/';
    final action foo <- base;       # /base/foo

=head2 Arguments

You can use signatures like you are use to from L<MooseX::Method::Signatures>
to declare action parameters. The number of arguments will be used during 
dispatching. Dispatching by type constraint is planned but not yet implemented.

The signature follows the action name:

    # /foo/*/*/*
    final action foo (Int $year, Int $month, Int $day);

If you are using the shorthand definition, the signature follows the chain 
target:

    # /foo/*
    final action foo <- base ($x) under '/' { ... }

Parameters may be specified on chain-parts and end-points:

    # /base/*/foo/*
    action base (Str $lang) under '/';
    final action page (Int $page_num) under base;

Named parameters will be populated with the values in the query parameters:

    # /view/17/?page=3
    final action view (Int $id, Int :$page = 1) under '/';

Your end-points can also take an unspecified amount of arguments by specifying
an array as a variable:

    # /find/some/deep/path/spec
    final action find (@path) under '/';

=head2 Actions and Method Modifiers

Method modifiers can not only be applied to methods, but also to actions. There
is no way yet to override the attributes of an already established action via
modifiers. However, you can modify the method underlying the action.

The following code is an example role modifying the consuming controller's
C<base> action:

    use CatalystX::Declare;

    controller_role MyApp::Web::ControllerRole::RichBase {

        before base (Object $ctx) {
            $ctx->stash(something => $ctx->model('Item'));
        }
    }

Note that you have to specify the C<$ctx> argument yourself, since you are 
modifying a method, not an action.

Any controller having a C<base> action (or method, for this purpose), can now
consume the C<RichBase> role declared above:

    use CatalystX::Declare;

    controller MyApp::Web::Controller::Foo
        with   MyApp::Web::Controller::RichBase {

        action base as '' under '/';

        action show, final under base { 
            $ctx->response->body(
                $ctx->stash->{something}->render,
            );
        }
    }

=head1 ROLES

=over

=item L<MooseX::Declare::Syntax::KeywordHandling>

=back

=head1 METHODS

These methods are implementation details. Unless you are extending or 
developing L<CatalystX::Declare>, you should not be concerned with them.

=head2 parse

    Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)

A hook that will be invoked by L<MooseX::Declare> when this instance is called 
to handle syntax. It will parse the action declaration, prepare attributes and 
add the actions to the controller.

=head1 SEE ALSO

=over

=item L<CatalystX::Declare>

=item L<CatalystX::Declare::Keyword::Controller>

=item L<MooseX::Method::Signatures>

=back

=head1 AUTHOR

See L<CatalystX::Declare/AUTHOR> for author information.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it under 
the same terms as perl itself.

=cut
Commit	Line	Data
918fb36e	1	use MooseX::Declare;
918fb36e	2
9c11a562	3	class CatalystX::Declare::Keyword::Action
918fb36e	4	with MooseX::Declare::Syntax::KeywordHandling {
	5
	6
a1dd1788	7	use Carp qw( croak );
	8	use Perl6::Junction qw( any );
	9	use Data::Dump qw( pp );
	10	use MooseX::Types::Util qw( has_available_type_export );
856ac9a7	11	use Moose::Util qw( add_method_modifier );
a1dd1788	12	use Class::Inspector;
	13	use Class::MOP;
	14
918fb36e	15
e10b92dd	16	use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
9c11a562	17	use constant UNDER_VAR => '$CatalystX::Declare::SCOPE::UNDER';
e10b92dd	18
918fb36e	19	use aliased 'MooseX::Method::Signatures::Meta::Method';
	20	use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
	21
	22
856ac9a7	23	method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
918fb36e	24
	25	# somewhere to put the attributes
	26	my %attributes;
	27	my @populators;
918fb36e	28
	29	# parse declarations
	30	until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
918fb36e	31
	32	$ctx->skipspace;
	33
	34	# optional commas
	35	if ($ctx->peek_next_char eq ',') {
	36
	37	my $linestr = $ctx->get_linestr;
	38	substr($linestr, $ctx->offset, 1) = '';
	39	$ctx->set_linestr($linestr);
	40
	41	next;
	42	}
	43
	44	# next thing should be an option name
	45	my $option = (
	46	$skipped_declarator
	47	? $ctx->strip_name
	48	: do {
	49	$ctx->skip_declarator;
	50	$skipped_declarator++;
	51	$ctx->declarator;
	52	})
	53	or croak "Expected option token, not " . substr($ctx->get_linestr, $ctx->offset);
	54
	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";
	58
	59	# call the handler
e10b92dd	60	my $populator = $self->$handler($ctx, \%attributes);
	61
	62	if ($populator and $populator eq STOP_PARSING) {
	63
	64	return $ctx->shadow(sub (&) {
	65	my ($body) = @_;
	66	return $body->();
	67	});
	68	}
	69
	70	push @populators, $populator
	71	if defined $populator;
918fb36e	72	}
	73
	74	croak "Need an action specification"
	75	unless exists $attributes{Signature};
	76
	77	my $name = $attributes{Subname};
856ac9a7	78
918fb36e	79	my $method = Method->wrap(
	80	signature => qq{($attributes{Signature})},
	81	package_name => $ctx->get_curstash_name,
	82	name => $name,
	83	);
	84
a1dd1788	85	AttributeRole->meta->apply($method);
a1dd1788	86
918fb36e	87	$_->($method)
	88	for @populators;
	89
aae7ad1f	90	unless ($attributes{Private}) {
aae7ad1f	91	$attributes{PathPart} \|\|= "'$name'";
918fb36e	92
aae7ad1f	93	delete $attributes{CaptureArgs}
aae7ad1f	94	if exists $attributes{Args};
918fb36e	95
aae7ad1f	96	$attributes{CaptureArgs} = 0
	97	unless exists $attributes{Args}
	98	or exists $attributes{CaptureArgs};
	99	}
	100
	101	if ($attributes{Private}) {
aae7ad1f	102	delete $attributes{ $_ }
	103	for qw( Args CaptureArgs Chained Signature Subname Action );
	104	}
918fb36e	105
	106	if ($ctx->peek_next_char eq '{') {
	107	$ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
	108	}
	109	else {
	110	$ctx->inject_code_parts_here(
	111	sprintf '{ %s%s }',
	112	$ctx->scope_injector_call,
	113	$method->injectable_code,
	114	);
	115	}
	116
918fb36e	117	my @attributes = map {
	118	join('',
	119	$_,
aae7ad1f	120	ref($attributes{ $_ }) eq 'ARRAY'
	121	? ( scalar(@{ $attributes{ $_ } })
	122	? sprintf('(%s)', join(' ', @{ $attributes{ $_ } }))
	123	: '' )
	124	: "($attributes{ $_ })"
918fb36e	125	);
	126	} keys %attributes;
	127
	128	return $ctx->shadow(sub (&) {
	129	my $class = caller;
856ac9a7	130	my $body = shift;
918fb36e	131
856ac9a7	132	$method->_set_actual_body($body);
918fb36e	133	$method->{attributes} = \@attributes;
856ac9a7	134
	135	if ($modifier) {
	136
	137	add_method_modifier $class, $modifier, [$name, $method];
	138	}
	139	else {
	140
	141	$class->meta->add_method($name, $method);
	142	$class->meta->register_method_attributes($class->can($method->name), \@attributes);
	143	}
918fb36e	144	});
	145	}
	146
a1dd1788	147	method _handle_with_option (Object $ctx, HashRef $attrs) {
	148
	149	my $role = $ctx->strip_name
	150	or croak "Expected bareword role specification for action after with";
	151
	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))) {
	154	$role = $alias;
	155	}
	156
	157	push @{ $attrs->{CatalystX_Declarative_ActionRoles} \|\|= [] }, $role;
	158
	159	return;
	160	}
	161
	162	method _handle_isa_option (Object $ctx, HashRef $attrs) {
	163
	164	my $class = $ctx->strip_name
	165	or croak "Expected bareword action class specification for action after isa";
	166
	167	if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
	168	$class = $alias;
	169	}
	170
	171	$attrs->{CatalystX_Declarative_ActionClass} = $class;
	172
	173	return;
	174	}
	175
	176	method _check_for_available_import (Object $ctx, Str $name) {
	177
	178	if (my $code = $ctx->get_curstash_name->can($name)) {
	179	return $code->();
	180	}
	181
	182	return undef;
	183	}
	184
918fb36e	185	method _handle_action_option (Object $ctx, HashRef $attrs) {
	186
	187	# action name
	188	my $name = $ctx->strip_name
	189	or croak "Anonymous actions not yet supported";
	190
64baeca0	191	$ctx->skipspace;
	192	my $populator;
	193
	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);
	199	}
	200
918fb36e	201	# signature
	202	my $proto = $ctx->strip_proto \|\| '';
	203	$proto = join(', ', 'Object $self: Object $ctx', $proto \|\| ());
	204
	205	$attrs->{Subname} = $name;
	206	$attrs->{Signature} = $proto;
aae7ad1f	207	$attrs->{Action} = [];
918fb36e	208
9c11a562	209	if (defined $CatalystX::Declare::SCOPE::UNDER) {
9c11a562	210	$attrs->{Chained} \|\|= $CatalystX::Declare::SCOPE::UNDER;
e10b92dd	211	}
e10b92dd	212
64baeca0	213	return unless $populator;
64baeca0	214	return $populator;
918fb36e	215	}
918fb36e	216
2dde75e7	217	method _handle_final_option (Object $ctx, HashRef $attrs) {
	218
	219	return $self->_build_flag_populator($ctx, $attrs, 'final');
	220	}
	221
918fb36e	222	method _handle_is_option (Object $ctx, HashRef $attrs) {
	223
	224	my $what = $ctx->strip_name
	225	or croak "Expected symbol token after is symbol, not " . substr($ctx->get_linestr, $ctx->offset);
	226
2dde75e7	227	return $self->_build_flag_populator($ctx, $attrs, $what);
	228	}
	229
	230	method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
	231
918fb36e	232	return sub {
	233	my $method = shift;
	234
	235	if ($what eq any qw( end endpoint final )) {
	236	my $count = $self->_count_positional_arguments($method);
	237	$attrs->{Args} = defined($count) ? $count : '';
	238	}
	239	elsif ($what eq 'private') {
aae7ad1f	240	$attrs->{Private} = [];
918fb36e	241	}
	242	};
	243	}
	244
	245	method _handle_under_option (Object $ctx, HashRef $attrs) {
	246
	247	my $target = $self->_strip_actionpath($ctx);
e10b92dd	248	$ctx->skipspace;
	249
	250	if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
	251	$ctx->inject_if_block(
a1dd1788	252	sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
a1dd1788	253	$ctx->scope_injector_call,
e10b92dd	254	UNDER_VAR,
	255	UNDER_VAR,
	256	$target,
	257	);
	258	return STOP_PARSING;
	259	}
	260
918fb36e	261	$attrs->{Chained} = "'$target'";
	262
	263	return sub {
	264	my $method = shift;
	265
	266	my $count = $self->_count_positional_arguments($method);
	267	$attrs->{CaptureArgs} = $count
	268	if defined $count;
	269	};
	270	}
	271
	272	method _handle_chains_option (Object $ctx, HashRef $attrs) {
	273
	274	$ctx->skipspace;
	275	$ctx->strip_name eq 'to'
	276	or croak "Expected to token after chains symbol, not " . substr($ctx->get_linestr, $ctx->offset);
	277
	278	return $self->_handle_under_option($ctx, $attrs);
	279	}
	280
	281	method _handle_as_option (Object $ctx, HashRef $attrs) {
	282
	283	$ctx->skipspace;
	284
	285	my $path = $self->_strip_actionpath($ctx);
	286	$attrs->{PathPart} = "'$path'";
	287
	288	return;
	289	}
	290
	291	method _count_positional_arguments (Object $method) {
	292	my $signature = $method->_parsed_signature;
	293
	294	if ($signature->has_positional_params) {
	295	my $count = @{ scalar($signature->positional_params) };
	296
	297	if ($count and ($signature->positional_params)[-1]->sigil eq '@') {
	298	return undef;
	299	}
	300
	301	return $count - 1;
	302	}
	303
	304	return 0;
	305	}
	306
	307	method _strip_actionpath (Object $ctx) {
	308
	309	$ctx->skipspace;
	310	my $linestr = $ctx->get_linestr;
	311	my $rest = substr($linestr, $ctx->offset);
	312
	313	if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
	314	substr($linestr, $ctx->offset, length($1)) = '';
	315	$ctx->set_linestr($linestr);
	316	return $1;
	317	}
a0ebba1d	318	elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]\|\/)* ) ' /ix) {
918fb36e	319	substr($linestr, $ctx->offset, length($1) + 2) = '';
	320	$ctx->set_linestr($linestr);
	321	return $1;
	322	}
	323	else {
	324	croak "Invalid syntax for action path: $rest";
	325	}
	326	}
	327	}
	328
856ac9a7	329	__END__
	330
	331	=head1 NAME
	332
	333	CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
	334
	335	=head1 SYNOPSIS
	336
	337	use CatalystX::Declare;
	338
	339	controller MyApp::Web::Controller::Example {
	340
	341	# chain base action with path part setting of ''
	342	# body-less actions don't do anything by themselves
6e2492a4	343	action base as '' under '/';
856ac9a7	344
	345	# simple end-point action
	346	action controller_class is final under base {
	347	$ctx->response->body( 'controller: ' . ref $self );
	348	}
	349
	350	# chain part actions can have arguments
	351	action str (Str $string) under base {
	352
	353	$ctx->stash(chars => [split //, $string]);
	354	}
	355
	356	# and end point actions too, of course
	357	action uc_chars (Int $count) under str is final {
	358
	359	my $chars = $ctx->stash->{chars};
	360	...
	361	}
	362
	363
	364	# you can use a shortcut for multiple actions with
	365	# a common base
	366	under base {
	367
	368	# this is an endpoint after base
	369	action normal is final;
	370
	371	# the final keyword can be used to be more
	372	# visually explicit about end-points
	373	final action some_action { ... }
	374	}
	375
	376	# of course you can also chain to external actions
	377	final action some_end under '/some/controller/some/action';
	378	}
	379
	380	=head1 DESCRIPTION
	381
	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.
	386
	387	You can choose to separate syntax elements via C<,> if you think it is more
	388	readable. The action declaration
	389
	390	action foo is final under base;
	391
	392	is parsed in exactly the same way if you write it as
	393
	394	action foo, is final, under base;
	395
	396	=head2 Basic Action Declaration
	397
	398	The simplest possible declaration is
	399
	400	action foo;
	401
6e2492a4	402	This would define a chain-part action chained to nothing with the name C<foo>
856ac9a7	403	and no arguments. Since it isn't followed by a block, the body of the action
	404	will be empty.
	405
	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
	409	C<get_item> method:
	410
	411	action foo {
	412	$ctx->stash(item => $self->get_item);
	413	}
	414
	415	=head2 Setting a Path Part
	416
	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).
	420
	421	To change that, use the C<as> option:
	422
6e2492a4	423	under something {
	424	action base as ''; # <empty>
	425	action something as 'foo/bar'; # foo/bar
	426	action barely as bareword; # bareword
	427	}
856ac9a7	428
	429	=head2 Chaining Actions
	430
	431	Currently, L<CatalystX::Declare> is completely based on the concept of
	432	L<chained actions\|Catalyst::DispatchType::Chained>. Every action you declare is
6e2492a4	433	chained or private. You can specify the action you want to chain to with the
6e2492a4	434	C<under> option:
856ac9a7	435
6e2492a4	436	action foo; # chained to nothing
856ac9a7	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
	440
	441	C<under> is also provided as a grouping keyword. Every action inside the block
	442	will be chained to the specified action:
	443
	444	under base {
	445	action foo { ... }
	446	action bar { ... }
	447	}
	448
	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
	451	is to be expected:
	452
6e2492a4	453	action base under '/';
856ac9a7	454
	455	under '/the/sink' is final action foo;
	456
	457	final action bar under base;
	458
	459	final action baz under base;
	460
	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>:
	465
	466	action foo chains to bar;
	467	action foo under bar;
	468
	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:
	472
6e2492a4	473	action base under '/';
856ac9a7	474	action foo under base is final; # /base/foo
	475
	476	You can also drop the C<is> part of the C<is final> option if you want:
	477
	478	under base, final action foo { ... }
	479
	480	You can make end-points more visually distinct by using the C<final> keyword
	481	instead of the option:
	482
6e2492a4	483	action base under '/';
856ac9a7	484	final action foo under base; # /base/foo
	485
	486	And of course, the C<final>, C<under> and C<action> keywords can be used in
	487	combination whenever needed:
	488
6e2492a4	489	action base as '' under '/';
856ac9a7	490
	491	under base {
	492
	493	final action list; # /list
	494
	495	action load;
	496
	497	under load {
	498
	499	final action view; # /list/load/view
	500	final action edit; # /list/load/edit
	501	}
	502	}
	503
	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:
	506
6e2492a4	507	action base under '/';
856ac9a7	508	final action foo <- base; # /base/foo
	509
	510	=head2 Arguments
	511
	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.
	515
	516	The signature follows the action name:
	517
	518	# /foo///*
	519	final action foo (Int $year, Int $month, Int $day);
	520
	521	If you are using the shorthand definition, the signature follows the chain
	522	target:
	523
	524	# /foo/*
6e2492a4	525	final action foo <- base ($x) under '/' { ... }
856ac9a7	526
	527	Parameters may be specified on chain-parts and end-points:
	528
	529	# /base//foo/
6e2492a4	530	action base (Str $lang) under '/';
856ac9a7	531	final action page (Int $page_num) under base;
	532
	533	Named parameters will be populated with the values in the query parameters:
	534
	535	# /view/17/?page=3
6e2492a4	536	final action view (Int $id, Int :$page = 1) under '/';
856ac9a7	537
	538	Your end-points can also take an unspecified amount of arguments by specifying
	539	an array as a variable:
	540
	541	# /find/some/deep/path/spec
6e2492a4	542	final action find (@path) under '/';
856ac9a7	543
	544	=head2 Actions and Method Modifiers
	545
	546	Method modifiers can not only be applied to methods, but also to actions. There
	547	is no way yet to override the attributes of an already established action via
	548	modifiers. However, you can modify the method underlying the action.
	549
	550	The following code is an example role modifying the consuming controller's
	551	C<base> action:
	552
	553	use CatalystX::Declare;
	554
	555	controller_role MyApp::Web::ControllerRole::RichBase {
	556
	557	before base (Object $ctx) {
	558	$ctx->stash(something => $ctx->model('Item'));
	559	}
	560	}
	561
	562	Note that you have to specify the C<$ctx> argument yourself, since you are
	563	modifying a method, not an action.
	564
	565	Any controller having a C<base> action (or method, for this purpose), can now
	566	consume the C<RichBase> role declared above:
	567
	568	use CatalystX::Declare;
	569
	570	controller MyApp::Web::Controller::Foo
	571	with MyApp::Web::Controller::RichBase {
	572
6e2492a4	573	action base as '' under '/';
856ac9a7	574
	575	action show, final under base {
	576	$ctx->response->body(
	577	$ctx->stash->{something}->render,
	578	);
	579	}
	580	}
	581
	582	=head1 ROLES
	583
	584	=over
	585
	586	=item L<MooseX::Declare::Syntax::KeywordHandling>
	587
	588	=back
	589
	590	=head1 METHODS
	591
	592	These methods are implementation details. Unless you are extending or
	593	developing L<CatalystX::Declare>, you should not be concerned with them.
	594
	595	=head2 parse
	596
	597	Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
	598
	599	A hook that will be invoked by L<MooseX::Declare> when this instance is called
	600	to handle syntax. It will parse the action declaration, prepare attributes and
	601	add the actions to the controller.
	602
	603	=head1 SEE ALSO
	604
	605	=over
	606
	607	=item L<CatalystX::Declare>
	608
	609	=item L<CatalystX::Declare::Keyword::Controller>
	610
	611	=item L<MooseX::Method::Signatures>
	612
	613	=back
	614
	615	=head1 AUTHOR
	616
	617	See L<CatalystX::Declare/AUTHOR> for author information.
	618
	619	=head1 LICENSE
	620
	621	This program is free software; you can redistribute it and/or modify it under
	622	the same terms as perl itself.
918fb36e	623
856ac9a7	624	=cut
918fb36e	625