¿Cuenta los grupos de captura en una expresión regular qr?

Question

Estoy trabajando en un proyecto que en un momento dado obtiene una lista de archivos de un servidor ftp. En ese momento, devuelve una matriz de archivos O, si se pasa una referencia regex opcional (es decir, qr), filtra la lista hacia abajo usando grep. Además, si ese qr tiene un grupo de captura, trata la sección capturada como un número de versión y devuelve un hashref donde las claves son las versiones y los valores son los nombres de los archivos (que se hubieran devuelto como la matriz si no hubiera grupos de captura) . El código es el siguiente (simplificado ligeramente)

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; 
    } 
} 

Esta aplicación intenta crear el hash y lo devuelve si tiene éxito. Mi pregunta es: ¿puedo detectar que el qr tiene un grupo de captura y solo intenta crear el hash si lo hace?

Answer 1

Se podría utilizar algo como:

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

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

Salida:

2 

Answer 2

usted podría utilizar YAPE::Regex a analizar la expresión regular para ver si hay una captura presentes:

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 

Answer 3

Ver nparen in 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; 
} 

Otra posibilidad para evitar la inspección de la pauta es simplemente confiar en el valor de $capture. Será 1 (valor real de Perl) en el caso de una coincidencia exitosa sin captura. Puede distinguirlo de la captura ocasional que devuelve 1 porque ese carece de la bandera IV.