--- /dev/null
+use MooseX::Declare;
+
+role CatalystX::Declare::Context::StringParsing {
+
+ use Devel::Declare;
+
+ after inject_code_parts_here (@args) {
+# print "INJECT " . $self->get_linestr . "\n";
+ #print "BLOCK $_\n" for @args;
+ }
+
+ after inject_if_block (@args) {
+# print "BLOCK " . $self->get_linestr . "\n";
+ #print "BLOCK $_\n" for @args;
+ }
+
+ method rest_of_line {
+
+ $self->skipspace;
+
+ my $linestr = $self->get_linestr;
+ my $left = substr $linestr, $self->offset;
+
+ return $left;
+ }
+
+ method strip_from_linestr (Int $chars) {
+
+ my $linestr = $self->get_linestr;
+ substr($linestr, $self->offset, $chars) = '';
+ $self->set_linestr($linestr);
+ }
+
+ method get_string {
+
+ my $left = $self->rest_of_line;
+
+ if ($left =~ /^"/ and my $num = Devel::Declare::toke_scan_str $self->offset) {
+
+ my $found = Devel::Declare::get_lex_stuff;
+ Devel::Declare::clear_lex_stuff;
+
+ $self->strip_from_linestr($num);
+
+ return qq{"$found"};
+ }
+ else {
+ return $self->get_scalar;
+ }
+ }
+
+ method get_scalar {
+
+ my $left = $self->rest_of_line;
+
+ if ($left =~ s/^ ( \$ [a-z_] [a-z0-9_]* ) //ix) {
+
+ my $found = $1;
+
+ $self->strip_from_linestr( length $found );
+
+ return qq{"$found"};
+ }
+ else {
+ return undef;
+ }
+ }
+}
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 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';
for qw( Args CaptureArgs Chained Signature Private );
}
+ $self->_inject_attributes($ctx, \%attributes);
+
if ($ctx->peek_next_char eq '{') {
$ctx->inject_if_block($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 };
- }
+ my $compile_attrs = sub {
+ my $attributes = shift;;
+ my @attributes;
+
+ for my $attr (keys %$attributes) {
+ my $value = $attributes->{ $attr };
+
+ next if $attr eq 'Chained' and $value eq UNDER_VAR;
+
+# $value = sprintf "'%s'", $value
+# if grep { $attr eq $_ } qw( Chained PathPart );
+
+ push @attributes,
+ map { sprintf '%s%s', $attr, defined($_) ? sprintf('(%s)', $_) : '' }
+ (ref($value) eq 'ARRAY')
+ ? @$value
+ : $value;
+ }
+
+ return \@attributes;
+ };
- return $ctx->shadow(sub (&) {
+ return $ctx->shadow(sub {
my $class = caller;
+ my $attrs = shift;
my $body = shift;
+ $body = $attrs and $attrs = {}
+ if ref $attrs eq 'CODE';
+
+ delete $attrs->{Chained}
+ unless defined $attrs->{Chained};
+
+ defined($attrs->{ $_ }) and $attrs->{ $_ } = sprintf "'%s'", $attrs->{ $_ }
+ for qw( Chained PathPart );
+
+# pp \%attributes;
+# pp $attrs;
+ my %full_attrs = (%attributes, %$attrs);
+# pp \%full_attrs;
+ my $compiled_attrs = $compile_attrs->(\%full_attrs);
+# pp $compiled_attrs;
+
my $real_method = $method->reify(
actual_body => $body,
- attributes => \@attributes,
+ attributes => $compiled_attrs,
);
if ($modifier) {
my ($meta) = @_;
$meta->add_method($name, $real_method);
- $meta->register_method_attributes($meta->name->can($real_method->name), \@attributes);
+ $meta->register_method_attributes($meta->name->can($real_method->name), $compiled_attrs);
};
if ($ctx->stack->[-1] and $ctx->stack->[-1]->is_parameterized) {
$attrs->{Action} = [];
push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, CatchValidationError;
-
- if (defined $CatalystX::Declare::SCOPE::UNDER) {
- $attrs->{Chained} ||= $CatalystX::Declare::SCOPE::UNDER;
- }
+ $attrs->{Chained} ||= UNDER_VAR;
return unless $populator;
return $populator;
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) {
+
+ my @inject = qw( Chained PathPart );
+
+ my $code = sprintf ' +{ %s }, sub ',
+ join ', ',
+ map { (@$_) }
+# map { [$_->[0], sprintf '"%s"', $_->[1]] }
+# map { length( $_->[1] ) ? $_ : [$_->[0], "''"] }
+ map { defined( $_->[1] ) ? $_ : [$_->[0], 'undef'] }
+ map { [pp($_), $attrs->{ $_ }] }
+ grep { defined $attrs->{ $_ } }
+ @inject;
+
+ $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] };
if ($rest =~ /^ ( [_a-z] [_a-z0-9]* ) \b/ix) {
substr($linestr, $ctx->offset, length($1)) = '';
$ctx->set_linestr($linestr);
- return $1;
+ return $interp->($1);
}
elsif ($rest =~ /^ ' ( (?:[.:;,_a-z0-9]|\/)* ) ' /ix) {
substr($linestr, $ctx->offset, length($1) + 2) = '';
$ctx->set_linestr($linestr);
- return $1;
+ return $interp->($1);
+ }
+ elsif ($interpolate and my $str = $ctx->get_string) {
+ return $str;
}
else {
croak "Invalid syntax for action path: $rest";
}
}
+
+ with 'MooseX::Declare::Syntax::KeywordHandling';
+
+ around context_traits { $self->$orig, StringParsing }
}
__END__
projects / catagits/CatalystX-Declare.git / commitdiff