Come l'introspezione regex nella API Perl

Question

Sto lavorando a un codice che ha bisogno di serializzare regex Perl, comprese eventuali bandiere regex. Solo un sottoinsieme di flag è supportato, quindi devo rilevare quando flag non supportati come /u si trovano nell'oggetto espressioni regolari.

La versione corrente del codice fa questo:

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

quindi elabora manualmente string char-by-char di trovare bandiere.

Il problema qui è che l'in stringa di bandiere regex cambiato (penso in Perl 5.14) da esempio (?i-xsm:foo) a (?^i:foo), che rende l'analisi un dolore.

Potrei controllare la versione di perl, o semplicemente scrivere il parser per gestire entrambi i casi, ma qualcosa mi dice che ci deve essere un metodo superiore di introspezione disponibile.

Answer 1

In Perl, utilizza re::regexp_pattern.

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

Come si può vedere dalla fonte di regexp_pattern, non c'è alcuna funzione nelle API per ottenere tali informazioni, quindi vi consiglio di chiamare quella funzione troppo dalla XS troppo.

perlcall coperture chiamano funzioni Perl da C. Sono venuto con il seguente codice non testato:

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

Usage:

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 

Ma se si sta cercando di limitare le funzionalità più recenti, si hanno molto più lavoro da fare che solo controllando per/u.