计算 qr 正则表达式中的捕获组数量？

Question

我正在开发一个项目，该项目有时会从 ftp 服务器获取文件列表。此时，它要么返回文件的 arrayref，要么如果传递一个可选的正则表达式引用（即 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 具有捕获组，并且只有在有捕获组时才尝试创建哈希？

Answer 1

你可以使用类似的东西：

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

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

输出：

2

Answer 2

请参阅 Regexp::Parser 中的 nparen。

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 标志。

Answer 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