regex - reemplazar - Pasando una sustitución de expresiones regulares como una variable en Perl?

probar expresiones regulares

Question

Necesito pasar una sustitución de expresiones regulares como una variable:

sub proc {
    my $pattern = shift;
    my $txt = "foo baz";

    $txt =~ $pattern;
}

my $pattern = ''s/foo/bar/'';
proc($pattern);

Esto, por supuesto, no funciona. Intenté evaluar la sustitución:

eval("$txt =~ $pattern;");

pero eso tampoco funcionó. ¿Qué cosa tan obvia me estoy perdiendo aquí?

Answer 1

Necesito pasar una sustitución de expresiones regulares como una variable

¿Vos si? ¿Por qué no pasar una referencia de código? Ejemplo:

sub modify
{
  my($text, $code) = @_;
  $code->($text);
  return $text;
}

my $new_text = modify(''foo baz'', sub { $_[0] =~ s/foo/bar/ });

En general, cuando quiere pasar "algo que hace algo" a una subrutina ("una sustitución de expresiones regulares" en el caso de su pregunta), la respuesta es pasar una referencia a un fragmento de código. Higher Order Perl es un buen libro sobre el tema.

Answer 2

Bueno, puedes precompilar el RE usando el operador qr //. Pero no se puede pasar a un operador (s ///).

$pattern = qr/foo/;

print "match!/n" if $text =~ $pattern;

Pero si tiene que pasar el operador de sustitución, está dispuesto a pasar el código o las cadenas:

proc(''$text =~ s/foo/bar'');

sub proc { 
   my $code = shift;

   ...

   eval $code;
}

o, código:

proc(sub {my $text = shift;  $text =~ s/foo/bar});

sub proc {
   my $code = shift;

   ...

   $code->("some text");
}

Answer 3

Encontré una mejor manera de hacerlo:

sub proc {
    my ($pattern, $replacement) = @_;
    my $txt = "foo baz";

    $txt =~ s/$pattern/$replacement/g;  # This substitution is global.
}

my $pattern = qr/foo/;  # qr means the regex is pre-compiled.
my $replacement = ''bar'';

proc($pattern, $replacement);

Si los indicadores de la sustitución tienen que ser variables, puede usar esto:

sub proc {
    my ($pattern, $replacement, $flags) = @_;
    my $txt = "foo baz";

    eval(''$txt =~ s/$pattern/$replacement/'' . $flags);
}

proc(qr/foo/, ''bar'', ''g'');

Tenga en cuenta que no necesita escapar / en la cadena de reemplazo.

Answer 4

Tal vez puedas volver a pensar tu enfoque.

Desea pasar a una función una sustitución de expresiones regulares, probablemente porque la función derivará el texto para ser operado desde otra fuente (lectura de un archivo, conector, etc.). Pero estás combinando la expresión regular con la sustitución de expresiones regulares .

En la expresión, s/foo/bar/ , en realidad tiene una expresión regular ("/ foo /") y una sustitución ("barra") que debería reemplazar lo que coincide con la expresión. En los enfoques que has probado hasta ahora, te topaste con problemas al tratar de usar eval , principalmente debido a la probabilidad de que haya caracteres especiales en la expresión que interfieren con eval o se interpolan (es decir, engullido) en el proceso de evaluación.

Por lo tanto, intente pasarle a su rutina dos argumentos: la expresión y la sustitución:

sub apply_regex {
    my $regex = shift;
    my $subst = shift || ''''; # No subst string will mean matches are "deleted"

    # some setup and processing happens...

    # time to make use of the regex that was passed in:
    while (defined($_ = <$some_filehandle>)) {
        s/$regex/$subst/g; # You can decide if you want to use /g etc.
    }

    # rest of processing...
}

Este enfoque tiene un beneficio adicional: si su patrón de expresiones regulares no tiene ningún carácter especial, puede pasarlo directamente:

apply_regex(''foo'', ''bar'');

O, si lo hace, puede usar el operador qr// quoting-para crear un objeto regex y pasarlo como el primer parámetro:

apply_regex(qr{(foo|bar)}, ''baz'');
apply_regex(qr/[ab]+/, ''(one or more of "a" or "b")'');
apply_regex(qr|/d+|); # Delete any sequences of digits

Más que nada, realmente no necesita eval o el uso de referencias de código / cierres para esta tarea. Eso solo agregará complejidad que puede hacer que la depuración sea más difícil de lo que debe ser.

Cachondo

Answer 5

Tengo un script extremadamente simple para el cambio de nombre masivo de archivos que emplea este truco:

#!/opt/local/bin/perl
sub oops { die "Usage : sednames s/old/new [files ..]/n"; }
oops if ($#ARGV < 0);

$regex = eval ''sub { $_ = $_[0]; '' . shift(@ARGV) . ''; return $_; }'';
sub regex_rename { foreach (<$_[0]>) {
    rename("$_", &$regex($_));
} }

if ($#ARGV < 0) {  regex_rename("*");  }
else {  regex_rename(@ARGV);  }

Se puede utilizar cualquier comando perl que modifique $_ like s/old/new para modificar los archivos.

Decidí usar eval para que la expresión regular solo se compilara una vez. Hay algo de wonkiness con eval y $_ que me impidió usar simplemente:

eval ''sub { '' . shift(@ARGV) . '' }'';

aunque this &$regex ciertamente modifica $_ ; requiriendo que "$_" evalúe $_ antes de llamar a rename . Sí, eval es bastante frágil, como todos los demás dijeron.

Answer 6

Tienes razón, fuiste muy cercano:

eval(''$txt =~ '' . "$pattern;");

Answer 7

s/// no es una expresión regular. Por lo tanto, no puedes pasarlo como una expresión regular.

No me gusta eval para esto, es muy frágil, con muchos bordercases.

Creo que es mejor tomar un enfoque similar al que toma Javascript: pasar tanto una expresión regular (en Perl, que es qr// ) como una referencia de código para la sustitución. Por ejemplo, pasar parámetros para obtener el mismo efecto que

s/(/w+)//u/L$1/g;

Puedes llamar

replace($string, qr/(/w+)/, sub { "/u/L$1" }, ''g'');

Tenga en cuenta que el modificador ''g'' no es realmente una bandera para la expresión regular (creo que adjuntarla a la expresión regular es un error de diseño en Javascript), por lo que decidí pasarla en un tercer parámetro.

Una vez que se ha decidido la API, la implementación se puede hacer a continuación:

sub replace {
    my($string, $find, $replace, $global) = @_;
    unless($global) {
        $string =~ s($find){ $replace->() }e;
    } else {
        $string =~ s($find){ $replace->() }ge;
    }
    return $string;
}

Vamos a intentarlo:

print replace(''content-TYPE'', qr/(/w+)/, sub { "/u/L$1" }, ''g'');

Resultado:

Tipo de contenido

Eso se ve bien para mí.

Answer 8

eval "$txt =~ $pattern"; Esto se convierte

eval "/"foo baz/" =~ s/foo/bar/" y las sustituciones no funcionan en cadenas literales.

Esto funcionaría:

eval "/$txt =~ $pattern" pero eso no es muy agradable. eval casi nunca es la solución correcta.

La solución de zigdon puede hacer cualquier cosa, y la solución de Jonathan es bastante adecuada si la cadena de reemplazo es estática. Si quieres algo más estructurado que el primero y más flexible que el segundo, te sugiero un híbrido:

sub proc { my $pattern = shift; my $code = shift; my $txt = "foo baz"; $txt =~ s/$pattern/$code->()/e; print "$txt/n"; } my $pattern = qr/foo/; proc($pattern, sub { "bar" }); # ==> bar baz proc($pattern, sub { "/U$&" }); # ==> FOO baz

Answer 9

sub proc {
    my($match, $subst) = @_;
    my $txt = "foo baz";
    $txt =~ s/$match/$subst/;
    print "$txt/n";
}

my $matcher = qr/foo/;
my $sub_str = "bar";

proc($matcher, $sub_str);

Esto responde de manera bastante directa a tu pregunta. Puede hacer más, pero cuando utilicé un término qr // en lugar del $ sub_str como un simple literal, se sustituyó la expresión regular expandida.

Recientemente necesité crear un analizador sintáctico (analizador de pruebas) para declaraciones con algunos tipos de SQL peculiares (dialecto de), reconociendo líneas como esta, dividiéndola en tres tipos de nombres:

input: datetime year to second,decimal(16,6), integer

La secuencia de comandos que utilicé para la demostración de esta utilizó expresiones regulares citadas.

#!/bin/perl -w
use strict;
while (<>)
{
    chomp;
    print "Read: <$_>/n";
    my($r1) = qr%^input/s*:/s*%i;
    if ($_ =~ $r1)
    {
        print "Found input:/n";
        s%$r1%%;
        print "Residue: <$_>/n";
        my($r3) = qr%(?:year|month|day|hour|minute|second|fraction(?:/([1-5]/))?)%;
        my($r2) = qr%
                        (?:/s*,?/s*)?   # Commas and spaces
                        (
                            (?:money|numeric|decimal)(?:/(/d+(?:,/d+)?/))?   |
                            int(?:eger)?  |
                            smallint      |
                            datetime/s+$r3/s+to/s+$r3
                        )
                    %ix;
        while ($_ =~ m/$r2/)
        {
            print "Got type: <$1>/n";
            s/$r2//;
        }
        print "Residue 2: <$_>/n";
    }
    else
    {
        print "No match:/n";
    }
    print "Next?/n";
}

Podemos discutir sobre el uso de nombres como $ r1, etc. Pero hizo el trabajo ... no fue, ni es, código de producción.