use MooseX::Declare;
+use MooseX::Role::Parameterized ();
-class CatalystX::Declare::Keyword::Action
- with MooseX::Declare::Syntax::KeywordHandling {
+class CatalystX::Declare::Keyword::Action {
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 'CatalystX::Declare::Context::StringParsing';
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) {
+ method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
# somewhere to put the attributes
my %attributes;
my @populators;
- my $skipped_declarator;
# parse declarations
until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
unless exists $attributes{Signature};
my $name = $attributes{Subname};
+
my $method = Method->wrap(
signature => qq{($attributes{Signature})},
package_name => $ctx->get_curstash_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'";
+ $attributes{PathPart} ||= $name;
delete $attributes{CaptureArgs}
if exists $attributes{Args};
if ($attributes{Private}) {
delete $attributes{ $_ }
- for qw( Args CaptureArgs Chained Signature Subname Action );
+ for qw( Args CaptureArgs Chained Signature Private );
}
+ # inject a hashref for resolving runtime attribute values
+ $self->_inject_attributes($ctx, \%attributes);
+
+ # our declaration is followed by a block
if ($ctx->peek_next_char eq '{') {
$ctx->inject_if_block($ctx->scope_injector_call . $method->injectable_code);
}
+
+ # there is no block, so we insert one.
else {
$ctx->inject_code_parts_here(
sprintf '{ %s%s }',
);
}
- my @attributes = map {
- join('',
- $_,
- ref($attributes{ $_ }) eq 'ARRAY'
- ? ( scalar(@{ $attributes{ $_ } })
- ? sprintf('(%s)', join(' ', @{ $attributes{ $_ } }))
- : '' )
- : "($attributes{ $_ })"
- );
- } keys %attributes;
+ my $compile_attrs = sub {
+ my $attributes = shift;;
+ my @attributes;
+
+ for my $attr (keys %$attributes) {
+ my $value = $attributes->{ $attr };
- return $ctx->shadow(sub (&) {
+ # the compiletime chained attr might contain the under global var name
+ next if $attr eq 'Chained' and $value eq UNDER_VAR;
+
+ push @attributes,
+ map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
+ (ref($value) eq 'ARRAY')
+ ? @$value
+ : $value;
+ }
+
+ return \@attributes;
+ };
+
+ return $ctx->shadow(sub {
my $class = caller;
+ my $attrs = shift;
+ my $body = shift;
- $method->_set_actual_body(shift);
- $method->{attributes} = \@attributes;
-
- $class->meta->add_method($name, $method);
- $class->meta->register_method_attributes($class->can($method->name), \@attributes);
+ # the runtime-resolved name
+ my $name = $attrs->{Subname};
+
+ # in case no hashref was specified
+ $body = $attrs and $attrs = {}
+ if ref $attrs eq 'CODE';
+
+ # default path part to runtime-resolved name
+ unless ($attrs->{Private}) {
+
+ $attrs->{PathPart} = $attrs->{Subname}
+ unless defined $attrs->{PathPart};
+ }
+
+ # in CXD we are explicit about chained values, an undefined
+ # value means we defaulted to the outer-scope under and there
+ # was none.
+ delete $attrs->{Chained}
+ unless defined $attrs->{Chained};
+
+ # some attrs need to be single quoted in their stringified forms
+ defined($attrs->{ $_ }) and $attrs->{ $_ } = sprintf "'%s'", $attrs->{ $_ }
+ for qw( Chained PathPart );
+
+ # merge runtime and compiletime attrs
+ my %full_attrs = (%attributes, %$attrs);
+ my $compiled_attrs = $compile_attrs->(\%full_attrs);
+
+ my $real_method = $method->reify(
+ actual_body => $body,
+ attributes => $compiled_attrs,
+ name => $name,
+ );
+
+ # NYI
+ if ($modifier) {
+
+ add_method_modifier $class, $modifier, [$name, $real_method];
+ }
+ else {
+
+ my $prepare_meta = sub {
+ my ($meta) = @_;
+
+ $meta->add_method($name, $real_method);
+ $meta->register_method_attributes($meta->name->can($real_method->name), $compiled_attrs);
+ };
+
+ 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;
+ }
+ else {
+
+ $class->meta->$prepare_meta;
+ }
+ }
});
}
method _handle_action_option (Object $ctx, HashRef $attrs) {
# action name
- my $name = $ctx->strip_name
+ my $name = $self->_strip_actionpath($ctx, interpolate => 1)
or croak "Anonymous actions not yet supported";
$ctx->skipspace;
my $populator;
+ # shortcut under base option is basically handled by the under handler
if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
my $linestr = $ctx->get_linestr;
substr($linestr, $ctx->offset, 2) = '';
$attrs->{Signature} = $proto;
$attrs->{Action} = [];
- if (defined $CatalystX::Declare::SCOPE::UNDER) {
- $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
- }
+ push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
+
+ # default chained base to the global under var, to be resolved at runtime
+ $attrs->{Chained} ||= UNDER_VAR;
return unless $populator;
return $populator;
my $method = shift;
if ($what eq any qw( end endpoint final )) {
- my $count = $self->_count_positional_arguments($method);
- $attrs->{Args} = defined($count) ? $count : '';
+ $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);
+ my $target = $self->_strip_actionpath($ctx, interpolate => 1);
$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,
+ $ctx->scope_injector_call .
+ sprintf ';local %s = %s;',
UNDER_VAR,
$target,
);
return STOP_PARSING;
}
- $attrs->{Chained} = "'$target'";
+ $attrs->{Chained} = $target;
return sub {
my $method = shift;
-
- my $count = $self->_count_positional_arguments($method);
- $attrs->{CaptureArgs} = $count
- if defined $count;
};
}
$ctx->skipspace;
- my $path = $self->_strip_actionpath($ctx);
- $attrs->{PathPart} = "'$path'";
+ my $path = $self->_strip_actionpath($ctx, interpolate => 1);
+ $attrs->{PathPart} = $path;
return;
}
method _count_positional_arguments (Object $method) {
- my $signature = $method->_parsed_signature;
+ my $signature = $method->parsed_signature;
if ($signature->has_positional_params) {
my $count = @{ scalar($signature->positional_params) };
return 0;
}
- method _strip_actionpath (Object $ctx) {
+ method _inject_attributes (Object $ctx, HashRef $attrs) {
+
+ # attrs that need to be runtime-resolved
+ my @inject = qw( Chained PathPart Subname );
+
+ # turn specific attributes into a hashref
+ my $code = sprintf ' +{ %s }, sub ', # the ', sub ' turns method +{ ... } { ... } into
+ join ', ', # method +{ ... }, sub { ... }
+ map { (@$_) }
+ map { defined( $_->[1] ) ? $_ : [$_->[0], 'undef'] }
+ map { [pp($_), $attrs->{ $_ }] }
+ grep { defined $attrs->{ $_ } }
+ @inject;
+
+ # inject the hashref code before the action body
+ $ctx->inject_code_parts_here($code);
+ $ctx->inc_offset(length $code);
+ }
+
+ method _strip_actionpath (Object $ctx, :$interpolate?) {
$ctx->skipspace;
my $linestr = $ctx->get_linestr;
my $rest = substr($linestr, $ctx->offset);
+ my $interp = sub { $interpolate ? "'$_[0]'" : $_[0] };
+ # find simple barewords
if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
substr($linestr, $ctx->offset, length($1)) = '';
$ctx->set_linestr($linestr);
- return $1;
+ return $interp->($1);
}
+
+ # allow single quoted more complex barewords
elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
substr($linestr, $ctx->offset, length($1) + 2) = '';
$ctx->set_linestr($linestr);
- return $1;
+ return $interp->($1);
}
+
+ # double quoted strings and variables
+ elsif ($interpolate and my $str = $ctx->get_string) {
+ return $str;
+ }
+
+ # not suitable as action path
else {
croak "Invalid syntax for action path: $rest";
}
}
+
+ # down here because it requires the parse method
+ with 'MooseX::Declare::Syntax::KeywordHandling';
+
+ around context_traits { $self->$orig, StringParsing }
}
+__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 Why $ctx instead of $c
+
+Some might ask why the context object is called C<$ctx> instead of the usual
+C<$c>. The reason is simple: It's an opinionated best practice, since C<$ctx>
+stands out more.
+
+=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_integer (Int $x) {
+ $ctx->response->body( $x * 2 );
+ }
+
+ final as double, action double_string (Str $x) {
+ $ctx->response->body( $x 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
projects / catagits/CatalystX-Declare.git / blobdiff