Рассчитать группы захвата в регулярном выражении qr?

Я работаю над проектом, который в какой-то момент получает список файлов с ftp-сервера. В этот момент он либо возвращает arrayref файлов, либо если передана необязательная ссылка regex (т.е. qr), она фильтрует список вниз с помощью grep. Кроме того, если qr имеет группу захвата, он обрабатывает захваченный раздел как номер версии и возвращает вместо него hashref, где ключи являются версиями, а значениями являются имена файлов (которые были бы возвращены как массив, если нет захвата группы). Код выглядит (слегка упрощен)

sub filter_files {
  my ($files, $pattern) = @_;
  my @files = @$files;
  unless ($pattern) {
    return \@files;
  }

  @files = grep { $_ =~ $pattern } @files;
  carp "Could not find any matching files" unless @files;

  my %versions = 
    map { 
      if ($_ =~ $pattern and defined $1) { 
        ( $1 => $_ )
      } else {
        ()
      }
    } 
    @files;

  if (scalar keys %versions) {
    return \%versions;
  } else {
    return \@files;
  }
}

Эта реализация пытается создать хэш и возвращает ее, если она преуспевает. Мой вопрос: могу ли я обнаружить, что qr имеет группу захвата и только пытается создать хэш, если он делает?

Ответ 1

Вы можете использовать что-то вроде:

sub capturing_groups{
    my $re = shift;
    "" =~ /|$re/;
    return $#+;
}

say capturing_groups qr/fo(.)b(..)/;

Вывод:

Ответ 2

См. nparen в Regexp::Parser.

use strictures;
use Carp qw(carp);
use Regexp::Parser qw();
my $parser = Regexp::Parser->new;

sub filter_files {
    my ($files, $pattern) = @_;
    my @files = @$files;
    return \@files unless $pattern;

    carp sprintf('Could not inspect regex "%s": %s (%d)',
        $pattern, $parser->errmsg, $parser->errnum)
        unless $parser->regex($pattern);

    my %versions;
    @files = map {
        if (my ($capture) = $_ =~ $pattern) {
            $parser->nparen
                ? push @{ $versions{$capture} }, $_
                : $_
        } else {
            ()
        }
    } @files;
    carp 'Could not find any matching files' unless @files;

    return (scalar keys %versions)
        ? \%versions
        : \@files;
}

Другая возможность избежать проверки шаблона - это просто полагаться на значение $capture. Это будет 1 (истинное значение Perl) в случае успешного совпадения без захвата. Вы можете отличить его от случайного захвата, возвращающего 1, потому что ему не хватает флага IV.

Ответ 3

Вы можете использовать YAPE:: Regex для синтаксического анализа регулярного выражения, чтобы увидеть, есть ли захват:

use warnings;
use strict;
use YAPE::Regex;

filter_files(qr/foo.*/);
filter_files(qr/(foo).*/);

sub filter_files {
    my ($pattern) = @_;
    print "$pattern ";
    if (has_capture($pattern)) {
        print "yes capture\n";
    }
    else {
        print "no capture\n";
    }
}

sub has_capture {
    my ($pattern) = @_;
    my $cap = 0;
    my $p = YAPE::Regex->new($pattern);
    while ($p->next()) {
        if (scalar @{ $p->{CAPTURE} }) {
            $cap = 1;
            last;
        }
    }
    return $cap;
}

__END__

(?-xism:foo.*) no capture
(?-xism:(foo).*) yes capture