Contare i gruppi di cattura in una regex qr?

Question

Sto lavorando a un progetto che a un certo punto ottiene un elenco di file da un server ftp. A quel punto restituisce un arrayrif di file OPPURE, se viene passato un riferimento regex facoltativo (ad esempio qr), filtra l'elenco utilizzando grep. Inoltre, se lo qr ha un gruppo di acquisizione, considera la sezione acquisita come un numero di versione e restituisce invece un hashref in cui le chiavi sono le versioni ei valori sono i nomi dei file (che sarebbe stato restituito come matrice se non ci sono gruppi di cattura) . Il codice è simile (semplificato un po ')

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

Questa implementazione cerca di creare l'hash e lo restituisce se riesce. La mia domanda è: posso rilevare che lo qr ha un gruppo di cattura e tenta solo di creare l'hash se lo fa?

Answer 1

Si potrebbe usare qualcosa come:

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

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

uscita:

2 

Answer 2

si potrebbe usare YAPE::Regex per analizzare l'espressione regolare per vedere se v'è una cattura presente:

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

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

Un'altra possibilità per evitare ispezionare il modello è fare affidamento semplicemente sul valore di $capture. Sarà 1 (valore reale Perl) nel caso di una corrispondenza riuscita senza acquisizione. Puoi distinguerlo dall'acquisizione occasionale restituendo 1 perché a quella manca la bandiera IV.