Cómo introspectar expresiones regulares en la API de Perl

Question

Estoy trabajando en algún código que necesite serializar expresiones regulares de Perl, incluidos los indicadores de expresiones regulares. Solo se admite un subconjunto de indicadores, por lo que necesito detectar cuando indicadores no compatibles como /u se encuentran en el objeto de expresión regular.

La versión actual del código hace esto:

static void serialize_regex_flags(buffer *buf, SV *sv) { 
    char flags[] = {0,0,0,0,0,0}; 
    unsigned int i = 0, f = 0; 
    STRLEN string_length; 
    char *string = SvPV(sv, string_length); 

procesa manualmente string char-por-char para encontrar banderas.

El problema aquí es que la stringificación de los indicadores de expresiones regulares ha cambiado (creo que en Perl 5.14), por ejemplo, (?i-xsm:foo) a (?^i:foo), lo que hace que analizar un dolor.

Pude consultar la versión de perl, o simplemente escribir el analizador para manejar ambos casos, pero algo me dice que debe haber un método superior de introspección disponible.

Answer 1

En Perl, usaría re::regexp_pattern.

my $re = qr/foo/i; 
my ($pat, $mods) = re::regexp_pattern($re); 
say $pat; # foo 
say $mods; # i 

Como se puede ver en la fuente de regexp_pattern, no hay ninguna función en la API para obtener esa información, por lo que recomendamos que llame a esa función también de XS también.

perlcall cubiertas de llamada Funciones de C. Perl me ocurrió con el siguiente código no probado:

/* Calls re::regexp_pattern to extract the pattern 
* and flags from a compiled regex. 
* 
* When re isn't a compiled regex, returns false, 
* and *pat_ptr and *flags_ptr are set to NULL. 
* 
* The caller must free() *pat_ptr and *flags_ptr. 
*/ 

static int regexp_pattern(char ** pat_ptr, char ** flags_ptr, SV * re) { 
    dSP; 
    int count; 
    ENTER; 
    SAVETMPS; 
    PUSHMARK(SP); 
    XPUSHs(re); 
    PUTBACK; 
    count = call_pv("re::regexp_pattern", G_ARRAY); 
    SPAGAIN; 

    if (count == 2) { 
     /* Pop last one first. */ 
     SV * flags_sv = POPs; 
     SV * pat_sv = POPs; 

     /* XXX Assumes no NUL in pattern */ 
     char * pat = SvPVutf8_nolen(pat_sv); 
     char * flags = SvPVutf8_nolen(flags_sv); 

     *pat_ptr = strdup(pat); 
     *flags_ptr = strdup(flags); 
    } else { 
     *pat_ptr = NULL; 
     *flags_ptr = NULL; 
    } 

    PUTBACK; 
    FREETMPS; 
    LEAVE; 

    return *pat_ptr != NULL; 
} 

Uso:

SV * re = ...; 

char * pat; 
char * flags; 
regexp_pattern(&pat, &flags, re); 

Answer 2

use Data::Dump::Streamer ':util'; 
my ($pattern, $flags) = regex(qr/foo/i); 
print "pattern: $pattern, flags: $flags\n"; 
# pattern: foo, flags: i 

Pero si usted está tratando de restringir las características más recientes, que tienen mucho más trabajo que hacer que sólo la comprobación de/u.