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 Data::Dump qw( pp );
use MooseX::Types::Util qw( has_available_type_export );
use Moose::Util qw( add_method_modifier ensure_all_roles );
+ use Data::Pond qw(pond_write_datum);
use Class::Inspector;
use Class::MOP;
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';
my $name = $attributes{Subname};
+ if ($attributes{Private}) {
+ $attributes{Signature} ||= '@';
+ }
+
my $method = Method->wrap(
signature => qq{($attributes{Signature})},
package_name => $ctx->get_curstash_name,
for @populators;
unless ($attributes{Private}) {
- $attributes{PathPart} ||= "'$name'";
+ $attributes{PathPart} ||= $name;
delete $attributes{CaptureArgs}
if exists $attributes{Args};
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;
- for my $attr (keys %attributes) {
- push @attributes,
- map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
- (ref($attributes{ $attr }) eq 'ARRAY')
- ? @{ $attributes{ $attr } }
- : $attributes{ $attr };
- }
+ 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 {
+ my $value = ref $_ ? pond_write_datum($_) : $_;
+ sprintf '%s%s', $attr, defined($value) ? sprintf('(%s)', $value) : ''
+ } (
+ 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($body);
- $method->{attributes} = \@attributes;
+ # the runtime-resolved name
+ my $name = $attrs->{Subname};
- if ($modifier) {
+ # in case no hashref was specified
+ $body = $attrs and $attrs = {}
+ if ref $attrs eq 'CODE';
- add_method_modifier $class, $modifier, [$name, $method];
+ # 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, $method);
- $meta->register_method_attributes($meta->name->can($method->name), \@attributes);
+ $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) {
$real_meta->$prepare_meta;
}
-
- $class->meta->$prepare_meta;
+ else {
+ $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";
+ my @roles_with_args = ();
+ push @roles_with_args, @{ $ctx->strip_names_and_args };
# 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;
- }
+ my @roles = ();
+ for my $role_with_arg(@roles_with_args) {
+ my ($role, $params) = @{$role_with_arg};
+ if($params) {
+ my ($first, @rest) = eval $params;
+ my %params = ref $first eq 'HASH' ? %$first : ($first, @rest); # both (%opts) and {%opts}
+ for my $key (keys %params) {
+ my $value = ref $params{$key} eq 'ARRAY' ? $params{$key} : [$params{$key}];
+ push @{ $attrs->{$key} ||=[] }, @$value;
+ ##push @{ $attrs->{$key} ||=[] }, $params;
+
+ }
+ }
- push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
+ if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
+ $role = $alias;
+ }
+ push @roles, $role;
+ }
+ push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, @roles;
return;
}
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} = [];
- push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
+ push @{ $attrs->{CatalystX_Declarative_DefaultActionRoles} ||= [] }, CatchValidationError;
- if (defined $CatalystX::Declare::SCOPE::UNDER) {
- $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
- }
+ # default chained base to the global under var, to be resolved at runtime
+ $attrs->{Chained} ||= UNDER_VAR;
return unless $populator;
return $populator;
method _build_flag_populator (Object $ctx, HashRef $attrs, Str $what) {
+ $attrs->{Private} = []
+ if $what eq 'private';
+
return sub {
my $method = shift;
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; BEGIN { push %s, %s; %s = qq(%s) };',
- $ctx->scope_injector_call(
- sprintf ';BEGIN { %s = pop %s };',
- UNDER_VAR,
- UNDER_STACK,
- ),
- UNDER_STACK,
- 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;
$ctx->skipspace;
- my $path = $self->_strip_actionpath($ctx);
- $attrs->{PathPart} = "'$path'";
+ my $path = $self->_strip_actionpath($ctx, interpolate => 1);
+ $attrs->{PathPart} = $path;
return;
}
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__
# /view/17/?page=3
final action view (Int $id, Int :$page = 1) under '/';
+If you specify a query parameter to be an C<ArrayRef>, it will be specially
+handled. For one, it will match even if there is no such value in the
+parameters. Second, it will always be wrapped as an array reference.
+
Your end-points can also take an unspecified amount of arguments by specifying
an array as a variable:
}
}
+You can consume multiple action roles similarly to the way you do with the
+class or role keyword:
+
+ action user
+ with LoggedIn
+ with isSuperUser {}
+
+Or
+
+ action User
+ with (LoggedIn, isSuperUser) {}
+
+Lastly, you can pass parameters to the underlying L<Catalyst::Action> using
+a syntax that is similar to method traits:
+
+ action myaction with hasRole(opt1=>'val1', opt2=>'val2')
+
+Where C<%opts> is a hash that is used to populate $action->attributes in the
+same way you might have done the following in classic L<Catalyst>
+
+ sub myaction :Action :Does(hasRole) :opt1(val1) :opt2(val2)
+
+Here's a more detailed example:
+
+ action User
+ with hasLogger(log_engine=>'STDOUT')
+ with hasPermissions(
+ role=>['Administrator', 'Member'],
+ ) {}
+
+Think of these are classic catalyst subroutine attributes on steriods. Unlike
+subroutine attributes, you can split and format your code across multiple lines
+and you can use deep and complex data structures such as HashRefs or ArrayRefs.
+Also, since the parameters are grouped syntactically within the C<with> keyword
+this should improve readability of your code, since it will be more clear which
+parameters belong to with roles. This should give L<CatalystX::Declare> greater
+compatibility with legacy L<Catalyst> code but offer us a way forward from
+needing subroutine attributes, which suffer from significant drawbacks.
+
+A few caveats and differences from method traits. First of all, unlike method
+traits, parameters are not passed to the L<Catalyst::Action> constructor, but
+instead used to populate the C<attributes> attribute, which is to preserve
+compatibility with how subroutine attributes work in classic L<Catalyst>.
+
+Additionally, since subroutines attributes supported a very limited syntax for
+supplying values, we follow the convention where parameter values are pushed
+onto an arrayref. In other words the following:
+
+ action User with hasLogger(engine=>'STDOUT')
+
+would create the following data structure:
+
+ $action->attributes->{engine} = ['STDOUT']
+
+The one exception is that if the value is an arrayref, those will be merged:
+
+ action User with Permissions(roles=>[qw/admin member/]) {}
+ ## Creates: $action->attributes->{roles} = ['admin','member']
+
+My feeling is that this gives better backward compatibility with classic sub
+attributes:
+
+ sub User :Action :Does(Permissions) :roles(admin) :roles(member)
+
+However, I realize this method could lead to namespace collisions within the
+C<$action->attributes> attribute. For now this is an avoidable issue. In the
+future we may add a C<$action->trait_attributes> or similar attribute to the
+L<Catalyst::Action> class in order to resolve this issue.
+
=head2 Action Classes
B<This option is even more experimental>
The loaded class will be L<Moose>ified, so we are able to apply essential
roles.
+=head2 Private Actions
+
+B<This option is a bit less, but still pretty experimental>
+
+You can declare private actions with the C<is private> trait:
+
+ action end is private isa RenderView;
+
=head1 ROLES
=over
projects / catagits/CatalystX-Declare.git / blobdiff