Как получить группу в рекурсивном регулярном выражении?

Question

Я пишу простое регулярное выражение, которое должно получить пару координат и / или имя карты.

Например:

move 10 15 # should returns [[10, 15]]
move 10 15 map # should returns [[10, 15, 'map']]
move map # should returns [['map']]
move 10 15 mapA mapB # should returns [[10, 15, 'mapA'], ['mapB']] 
move 10 15 mapA mapB 33 44 # should returns [[10, 15, 'mapA'], ['mapB'], [33, 44]]
move 10 15 mapA 33 44 mapB # should returns [[10, 15, 'mapA'], [33, 44, 'mapB']]

Затем я написал это регулярное выражение:

/
  (?(DEFINE)
     (?<coord>    (?<x>\d+)\s+(?<y>\d+) )
     (?<map>      (?<mapname>[a-zA-Z]+) )
     (?<commands> \s* (?: (?&coord) | (?&map) ) \s* (?&commands)? )
  )
  move\s+(?&commands)
/six

Но как я могу получить значение для групп x, y и map, используя Perl?

Я пытался несколькими способами:

use strict;
use warnings;

my $command = 'move 10 15';

$command =~ /
  (?(DEFINE)
     (?<coord>    (?<x>\d+)\s+(?<y>\d+) )
     (?<map>      (?<mapname>[a-zA-Z]+) )
     (?<commands> \s* (?: (?&coord) | (?&map) ) \s* (?&commands)? )
  )
  move\s+(?&commands)
/six;

while (my ($k,$v) = each %+) { print "$k $v\n" }
print "$+{x}";

Answer 1

Поскольку вопрос стоит, этого не может быть. perlre говорит об этом

Обратите внимание, что группы захвата, совпадающие внутри рекурсии, недоступны после возврата рекурсии, поэтому необходим дополнительный слой групп захвата.

, но шаблон <x> нельзя получить с «дополнительным слоем» захвата, поскольку он используется только внутри грамматики.У вас может быть только целое

if ($command =~ /
        move\s+ (?<match>(?&commands))
        (?(DEFINE)
            (?<coord>    (?<x>\d+)\s+(?<y>\d+) )
            (?<map>      (?<mapname>[a-zA-Z]+) )
            (?<commands> \s* (?: (?&coord) | (?&map) ) \s* (?&commands)? )
        )
    /six)
{
    say "got: $+{match}";
}

, куда я переместил блок ?(DEFINED) в конце шаблона, как рекомендовано.

Обратите внимание, что это не имеет смыслалибо: в рекурсивном совпадении какой из нескольких <x> должен быть получен?Таким образом, вам нужно реструктурировать подход, чтобы иметь возможность перехватить нужный вам матч;но я не понимаю, как это сделать, если вы хотите, чтобы подшаблон был похоронен так глубоко.

Для поставленной задачи я бы пошел с написанием простого синтаксического анализатора, не говоря уже о регулярном выражении, охватывающем все.Или, в вашем подходе, повторно обработайте совпадение для его частей, надеюсь, намного проще, когда он у вас есть.

А затем есть мощные инструменты, такие как Marpa :: R2 , Parse :: RecDescent , Regexp :: Грамматика .

Answer 2

Поскольку я пока не могу комментировать, у решения Стефана Беккера есть недостаток.

Он потерпит неудачу, если координата равна 0.

Вот исправление:

#!/usr/bin/perl
use warnings;
use strict;

use Data::Dumper;

while (<DATA>) {
    my @row;
    chomp;
    if (/^move/) {
        while (/(?:(\d+)\s+(\d+))?(?:\s+([[:alpha:]]+))?/g) {
            my @match;
            push(@match, +$1, +$2) if defined $1 && defined $2;
            push(@match, $3)       if $3;
            push(@row, \@match) if @match;
        }
    }

    print "$_: ", Dumper(\@row);
}

exit 0;

__DATA__
move 10 15
move 10 15 map
move map
move 10 15 mapA mapB
move 10 15 mapA mapB 33 44
move 10 15 mapA 33 44 mapB
move 0 15 mapA 33 44 mapB

Answer 3

Может быть, лучше разделить и победить, чем принудительно кормить все в одно регулярное выражение?

#!/usr/bin/perl
use warnings;
use strict;

use Data::Dumper;

while (<DATA>) {
    my @row;
    chomp;
    if (/^move/) {
        while (/(?:(\d+)\s+(\d+))?(?:\s+([[:alpha:]]+))?/g) {
            my @match;
            push(@match, +$1, +$2) if $1 && $2;
            push(@match, $3)       if $3;
            push(@row, \@match) if @match;
        }
    }

    print "$_: ", Dumper(\@row);
}

exit 0;

__DATA__
move 10 15
move 10 15 map
move map
move 10 15 mapA mapB
move 10 15 mapA mapB 33 44
move 10 15 mapA 33 44 mapB

Тестовый прогон:

$ perl dummy.pl
move 10 15: $VAR1 = [
          [
            '10',
            '15'
          ]
        ];
move 10 15 map: $VAR1 = [
          [
            '10',
            '15',
            'map'
          ]
        ];
move map: $VAR1 = [
          [
            'map'
          ]
        ];
move 10 15 mapA mapB: $VAR1 = [
          [
            '10',
            '15',
            'mapA'
          ],
          [
            'mapB'
          ]
        ];
move 10 15 mapA mapB 33 44: $VAR1 = [
          [
            '10',
            '15',
            'mapA'
          ],
          [
            'mapB'
          ],
          [
            '33',
            '44'
          ]
        ];
move 10 15 mapA 33 44 mapB: $VAR1 = [
          [
            '10',
            '15',
            'mapA'
          ],
          [
            '33',
            '44',
            'mapB'
          ]
        ];