- while (length $$str_ref) {
- my $copy = $$str_ref;
- if (defined(my $name = $self->parse_expr(\$copy, {auto_quote => qr{ ^ (\w+) $QR_AQ_NOTDOT }xo}))
- && $copy =~ s{ ^ = >? \s* $QR_COMMENTS }{}ox) {
- $self->throw('parse', 'Named arguments not allowed') if $ARGS->{'positional_only'};
- my $val = $self->parse_expr(\$copy);
- $copy =~ s{ ^ , \s* $QR_COMMENTS }{}ox;
+ my $name;
+ my $end = $self->{'_end_tag'} || '(?!)';
+ while (1) {
+ my $mark = pos $$str_ref;
+
+ ### look to see if the next thing is a directive or a closing tag
+ if (! $ARGS->{'is_parened'}
+ && ! $ARGS->{'require_arg'}
+ && $$str_ref =~ m{ \G $QR_DIRECTIVE (?: \s+ | (?: \s* $QR_COMMENTS (?: ;|[+=~-]?$end))) }gcxo
+ && ((pos($$str_ref) = $mark) || 1) # always revert
+ && $DIRECTIVES->{$self->{'ANYCASE'} ? uc($1) : $1} # looks like a directive - we are done
+ ) {
+ last;
+ }
+ if ($$str_ref =~ m{ \G [+=~-]? $end }gcx) {
+ pos($$str_ref) = $mark;
+ last;
+ }
+
+ ### find the initial arg
+ my $name;
+ if ($ARGS->{'allow_bare_filenames'}) {
+ $name = $self->parse_expr($str_ref, {auto_quote => "
+ ($QR_FILENAME # file name
+ | \\w+\\b (?: :\\w+\\b)* ) # or block
+ (?= [+=~-]? $end # an end tag
+ | \\s*[+,;] # followed by explicit + , or ;
+ | \\s+ (?! [\\s=]) # or space not before an =
+ ) \\s* $QR_COMMENTS"});
+ # filenames can be separated with a "+" - why a "+" ?
+ if ($$str_ref =~ m{ \G \+ (?! [+=~-]? $end) \s* $QR_COMMENTS }gcxo) {
+ push @args, $name;
+ $ARGS->{'require_arg'} = 1;
+ next;
+ }
+ }
+ if (! defined $name) {
+ $name = $self->parse_expr($str_ref);
+ if (! defined $name) {
+ if ($ARGS->{'require_arg'} && ! @args && ! $ARGS->{'positional_only'} && ! @named) {
+ $self->throw('parse', 'Argument required', undef, pos($$str_ref));
+ } else {
+ last;
+ }
+ }
+ }
+
+ $$str_ref =~ m{ \G \s* $QR_COMMENTS }gcxo;
+
+ ### see if it is named or positional
+ if ($$str_ref =~ m{ \G = >? \s* $QR_COMMENTS }gcxo) {
+ $self->throw('parse', 'Named arguments not allowed', undef, $mark) if $ARGS->{'positional_only'};
+ my $val = $self->parse_expr($str_ref);
+ $name = $name->[0] if ref($name) && @$name == 2 && ! $name->[1]; # strip a level of indirection on named arguments