Comment puis-je interpoler un tableau d'alternances dans une regex Perl?

Question

Est-il possible de le faire:

@foo = getPileOfStrings(); 

if($text =~ /@foo(*.?)@foo/) 
{ 
print "Sweet, you grabbed a $1! It lived between the foos!"; 
} 

Qu'est-ce qui se passe ici est je besoin d'un $text =~ /($var1|$var2|$var3)(*.?)($var1.../; Je ne sais pas combien de valeurs il y a, et je ne connais pas les valeurs avant l'exécution.

L'interpolation de tableau dans un ensemble d'ORs semblait être le moyen le plus simple de le faire, mais cela ne semble pas fonctionner correctement, et j'entre dans un jeu de code sinueux ... tout se ressemble!

Answer 1

Utilisez join et l'opérateur qr//:

my $strings = join "|", getPileOfStrings(); 
my $re  = qr/$strings/; #compile the pattern 

if ($text =~ /$re(*.?)$re/) 

Si vous souhaitez pour le même mot pour délimiter les choses au milieu disent:

if ($text =~/($re)(.*?)\1/) 

Si les chaînes peuvent contenir des caractères qui sont considérés comme spécial par Perl regexes, vous pouvez utiliser map et quotemeta pour les empêcher d'être utilisés par l'expression régulière:

my $strings = join "|", map quotemeta, getPileOfStrings(); 

Et, comme le souligne Michael Carman sur, si getPileOfStrings() ne vise pas à renvoyer les chaînes dans l'ordre que vous désirez être jumelés, vous pouvez utiliser sort pour forcer le plus long match pour être le premier dans l'alternance (articles précédents dans l'alternance correspondront d'abord en Perl 5):

my $strings = join "|" map quotemeta, 
    sort { length $a <=> length $b } getPileOfStrings(); 

Souvenez-vous de trier avant d'exécuter quotemeta depuis "a..." (longueur 4) sera transformé en "a\\.\\.\\." (longueur 6) est plus longue que "aaaaaa" (longueur 5).

Answer 2

Vous pouvez utiliser Regex::PreSuf:

my $re = presuf(getPileOfStrings()); 

Avant d'aller de l'avant avec cela, vous voudrez peut-être penser à ce que vous voulez le code suivant à faire:

#!/usr/bin/perl 

use strict; 
use warnings; 

my @pile = qw(ar a); 
my $string = 'ar5a'; 

my $pile = join '|', @pile; 
my $re = qr/$pile/; 

my ($captured) = $string =~ /$re(.*?)$re/; 

print "$captured\n"; 

Si vous voulez $captured contenir "r5", trier @pile par les longueurs de ses éléments avant de rejoindre comme dans

my $pile = join '|', sort { length $a <=> length $b } @pile;