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

use MooseX::Declare;
use MooseX::Role::Parameterized ();

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 ensure_all_roles );
    use Class::Inspector;
    use Class::MOP;


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

    use aliased 'CatalystX::Declare::Action::CatchValidationError';
    use aliased 'MooseX::Method::Signatures::Meta::Method';
    use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
    use aliased 'MooseX::MethodAttributes::Role::Meta::Role',   'AttributeMetaRole';


    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);

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

        $_->($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 Private );
        }

        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;
        for my $attr (keys %attributes) {
            push @attributes, 
                map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
                    (ref($attributes{ $attr }) eq 'ARRAY') 
                    ? @{ $attributes{ $attr } }
                    : $attributes{ $attr };
        }

        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 {

                my $prepare_meta = sub {
                    my ($meta) = @_;

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

                if ($ctx->stack->[-1] and $ctx->stack->[-1]->is_parameterized) {
                    my $real_meta = MooseX::Role::Parameterized->current_metaclass;

                    $real_meta->meta->make_mutable
                        if $real_meta->meta->is_immutable;
                    ensure_all_roles $real_meta->meta, AttributeMetaRole
                        if $real_meta->isa('Moose::Meta::Role');

                    $real_meta->$prepare_meta;
                }

                $class->meta->$prepare_meta;
            }
        });
    }

    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}    = [];

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

        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 )) {
                $attrs->{Args} = delete $attrs->{CaptureArgs};
            }
            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; BEGIN { push %s, %s; %s = qq(%s) };',
                    $ctx->scope_injector_call(
                        sprintf ';BEGIN { %s = pop %s };', 
                            UNDER_VAR,
                            UNDER_STACK,
                    ),
                    UNDER_STACK,
                    UNDER_VAR,
                    UNDER_VAR,
                    $target,
            );
            return STOP_PARSING;
        }

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

        return sub {
            my $method = shift;
        };
    }

    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 { ... }

            # type dispatching works
            final action with_str (Str $x) as via_type;
            final action with_int (Int $x) as via_type;
        }

        # 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 positinoal arguments will be used 
during dispatching as well as their types.

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 Validation

The signatures are now validated during dispatching-time, and an action with
a non-matching signature (number of positional arguments and their types) will
not be dispatched to. This means that

    action base under '/' as '';

    under base {

        final as double, action double_string (Str $x) {
            $ctx->response->body( $x x 2 );
        }

        final as double, action double_integer (Int $x) {
            $ctx->response->body( $x * 2 );
        }
    }

will return C<foofoo> when called as C</double/foo> and C<46> when called as
C</double/23>.

=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,
            );
        }
    }

=head2 Action Classes

B<This option is even more experimental>

You might want to create an action with a different class than the usual
L<Catalyst::Action>. A usual suspect here is L<Catalyst::Action::RenderView>.
You can use the C<isa> option (did I mention it's experimental?) to specify
what class to use:

    controller MyApp::Web::Controller::Root {

        $CLASS->config(namespace => '');

        action end isa RenderView;
    }

The loaded class will be L<Moose>ified, so we are able to apply essential
roles.

=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;
c2a8165b	2	use MooseX::Role::Parameterized ();
918fb36e	3
9c11a562	4	class 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';
918fb36e	23	use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
c2a8165b	24	use aliased 'MooseX::MethodAttributes::Role::Meta::Role', 'AttributeMetaRole';
918fb36e	25
918fb36e	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);
a1dd1788	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}) {
aae7ad1f	99	$attributes{PathPart} \|\|= "'$name'";
918fb36e	100
aae7ad1f	101	delete $attributes{CaptureArgs}
aae7ad1f	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;
5fb5cef1	233
9c11a562	234	if (defined $CatalystX::Declare::SCOPE::UNDER) {
9c11a562	235	$attrs->{Chained} \|\|= $CatalystX::Declare::SCOPE::UNDER;
e10b92dd	236	}
e10b92dd	237
64baeca0	238	return unless $populator;
64baeca0	239	return $populator;
918fb36e	240	}
918fb36e	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	}
918fb36e	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
	358	CatalystX::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
	411	This handler class provides the user with C<action>, C<final> and C<under>
	412	keywords. There are multiple ways to define actions to allow for greater
	413	freedom of expression. While the parts of the action declaration itself do
	414	not care about their order, their syntax is rather strict.
	415
	416	You can choose to separate syntax elements via C<,> if you think it is more
	417	readable. The action declaration
	418
	419	action foo is final under base;
	420
	421	is 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
	427	The simplest possible declaration is
	428
	429	action foo;
	430
6e2492a4	431	This would define a chain-part action chained to nothing with the name C<foo>
856ac9a7	432	and no arguments. Since it isn't followed by a block, the body of the action
	433	will be empty.
	434
	435	You will automatically be provided with two variables: C<$self> is, as you
	436	might expect, your controller instance. C<$ctx> will be the Catalyst context
	437	object. Thus, the following code would stash the value returned by the
	438	C<get_item> method:
	439
	440	action foo {
	441	$ctx->stash(item => $self->get_item);
	442	}
	443
	444	=head2 Setting a Path Part
	445
	446	As usual with Catalyst actions, the path part (the public name of this part of
	447	the URI, if you're not familiar with the term yet) will default to the name of
	448	the action itself (or more correctly: to whatever Catalyst defaults).
	449
	450	To change that, use the C<as> option:
	451
6e2492a4	452	under something {
	453	action base as ''; # <empty>
	454	action something as 'foo/bar'; # foo/bar
	455	action barely as bareword; # bareword
	456	}
856ac9a7	457
	458	=head2 Chaining Actions
	459
	460	Currently, L<CatalystX::Declare> is completely based on the concept of
	461	L<chained actions\|Catalyst::DispatchType::Chained>. Every action you declare is
6e2492a4	462	chained or private. You can specify the action you want to chain to with the
6e2492a4	463	C<under> option:
856ac9a7	464
6e2492a4	465	action foo; # chained to nothing
856ac9a7	466	action foo under '/'; # also chained to /
	467	action foo under bar; # chained to the local bar action
	468	action foo under '/bar/baz'; # chained to baz in /bar
	469
	470	C<under> is also provided as a grouping keyword. Every action inside the block
	471	will be chained to the specified action:
	472
	473	under base {
	474	action foo { ... }
	475	action bar { ... }
	476	}
	477
	478	You can also use the C<under> keyword for a single action. This is useful if
	479	you want to highlight a single action with a significant diversion from what
	480	is to be expected:
	481
6e2492a4	482	action base under '/';
856ac9a7	483
	484	under '/the/sink' is final action foo;
	485
	486	final action bar under base;
	487
	488	final action baz under base;
	489
	490	Instead of the C<under> option declaration, you can also use a more english
	491	variant named C<chains to>. While C<under> might be nice and concise, some
	492	people might prefer this if they confuse C<under> with the specification of
	493	a public path part. The argument to C<chains to> is the same as to C<under>:
	494
	495	action foo chains to bar;
	496	action foo under bar;
	497
	498	By default all actions are chain-parts, not end-points. If you want an action
	499	to be picked up as end-point and available via a public path, you have to say
	500	so explicitely by using the C<is final> option:
	501
6e2492a4	502	action base under '/';
856ac9a7	503	action foo under base is final; # /base/foo
	504
	505	You can also drop the C<is> part of the C<is final> option if you want:
	506
	507	under base, final action foo { ... }
	508
	509	You can make end-points more visually distinct by using the C<final> keyword
	510	instead of the option:
	511
6e2492a4	512	action base under '/';
856ac9a7	513	final action foo under base; # /base/foo
	514
	515	And of course, the C<final>, C<under> and C<action> keywords can be used in
	516	combination whenever needed:
	517
6e2492a4	518	action base as '' under '/';
856ac9a7	519
	520	under base {
	521
	522	final action list; # /list
	523
	524	action load;
	525
	526	under load {
	527
	528	final action view; # /list/load/view
	529	final action edit; # /list/load/edit
	530	}
	531	}
	532
	533	There is also one shorthand alternative for declaring chain targets. You can
	534	specify an action after a C<E<lt>-> following the action name:
	535
6e2492a4	536	action base under '/';
856ac9a7	537	final action foo <- base; # /base/foo
	538
	539	=head2 Arguments
	540
	541	You can use signatures like you are use to from L<MooseX::Method::Signatures>
ed4a2203	542	to declare action parameters. The number of positinoal arguments will be used
ed4a2203	543	during dispatching as well as their types.
856ac9a7	544
	545	The signature follows the action name:
	546
	547	# /foo///*
	548	final action foo (Int $year, Int $month, Int $day);
	549
	550	If you are using the shorthand definition, the signature follows the chain
	551	target:
	552
	553	# /foo/*
6e2492a4	554	final action foo <- base ($x) under '/' { ... }
856ac9a7	555
	556	Parameters may be specified on chain-parts and end-points:
	557
	558	# /base//foo/
6e2492a4	559	action base (Str $lang) under '/';
856ac9a7	560	final action page (Int $page_num) under base;
	561
	562	Named parameters will be populated with the values in the query parameters:
	563
	564	# /view/17/?page=3
6e2492a4	565	final action view (Int $id, Int :$page = 1) under '/';
856ac9a7	566
	567	Your end-points can also take an unspecified amount of arguments by specifying
	568	an array as a variable:
	569
	570	# /find/some/deep/path/spec
6e2492a4	571	final action find (@path) under '/';
856ac9a7	572
5fb5cef1	573	=head2 Validation
5fb5cef1	574
ed4a2203	575	The signatures are now validated during dispatching-time, and an action with
	576	a non-matching signature (number of positional arguments and their types) will
	577	not be dispatched to. This means that
	578
	579	action base under '/' as '';
	580
	581	under base {
	582
	583	final as double, action double_string (Str $x) {
	584	$ctx->response->body( $x x 2 );
	585	}
	586
	587	final as double, action double_integer (Int $x) {
	588	$ctx->response->body( $x * 2 );
	589	}
	590	}
	591
	592	will return C<foofoo> when called as C</double/foo> and C<46> when called as
	593	C</double/23>.
5fb5cef1	594
856ac9a7	595	=head2 Actions and Method Modifiers
	596
	597	Method modifiers can not only be applied to methods, but also to actions. There
	598	is no way yet to override the attributes of an already established action via
	599	modifiers. However, you can modify the method underlying the action.
	600
	601	The following code is an example role modifying the consuming controller's
	602	C<base> action:
	603
	604	use CatalystX::Declare;
	605
205323ac	606	controller_role MyApp::Web::ControllerRole::RichBase {
856ac9a7	607
	608	before base (Object $ctx) {
	609	$ctx->stash(something => $ctx->model('Item'));
	610	}
	611	}
	612
	613	Note that you have to specify the C<$ctx> argument yourself, since you are
	614	modifying a method, not an action.
	615
	616	Any controller having a C<base> action (or method, for this purpose), can now
	617	consume the C<RichBase> role declared above:
	618
	619	use CatalystX::Declare;
	620
	621	controller MyApp::Web::Controller::Foo
	622	with MyApp::Web::Controller::RichBase {
	623
6e2492a4	624	action base as '' under '/';
856ac9a7	625
	626	action show, final under base {
	627	$ctx->response->body(
	628	$ctx->stash->{something}->render,
	629	);
	630	}
	631	}
	632
2bb54af3	633	=head2 Action Classes
	634
	635	B<This option is even more experimental>
	636
	637	You might want to create an action with a different class than the usual
	638	L<Catalyst::Action>. A usual suspect here is L<Catalyst::Action::RenderView>.
	639	You can use the C<isa> option (did I mention it's experimental?) to specify
	640	what class to use:
	641
	642	controller MyApp::Web::Controller::Root {
	643
	644	$CLASS->config(namespace => '');
	645
	646	action end isa RenderView;
	647	}
	648
	649	The loaded class will be L<Moose>ified, so we are able to apply essential
	650	roles.
	651
856ac9a7	652	=head1 ROLES
	653
	654	=over
	655
	656	=item L<MooseX::Declare::Syntax::KeywordHandling>
	657
	658	=back
	659
	660	=head1 METHODS
	661
	662	These methods are implementation details. Unless you are extending or
	663	developing L<CatalystX::Declare>, you should not be concerned with them.
	664
	665	=head2 parse
	666
	667	Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
	668
	669	A hook that will be invoked by L<MooseX::Declare> when this instance is called
	670	to handle syntax. It will parse the action declaration, prepare attributes and
	671	add the actions to the controller.
	672
	673	=head1 SEE ALSO
	674
	675	=over
	676
	677	=item L<CatalystX::Declare>
	678
	679	=item L<CatalystX::Declare::Keyword::Controller>
	680
	681	=item L<MooseX::Method::Signatures>
	682
	683	=back
	684
	685	=head1 AUTHOR
	686
	687	See L<CatalystX::Declare/AUTHOR> for author information.
	688
	689	=head1 LICENSE
	690
	691	This program is free software; you can redistribute it and/or modify it under
	692	the same terms as perl itself.
918fb36e	693
856ac9a7	694	=cut
918fb36e	695