Jak introspekcja wyrażeń regularnych w interfejsie API Perl

Question

Pracuję nad kodem, który wymaga serializowania wyrażeń regularnych Perla, w tym dowolnych flag regex. Obsługiwany jest tylko podzbiór flag, więc muszę wykryć, czy nieobsługiwane flagi, takie jak /u, znajdują się w obiekcie regex.

Aktualna wersja kodu wykonuje to:

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

Następnie ręcznie przetwarza string char-by-char znalezienia flagi.

Problem w tym, że zmieniono szykowanie flag regex (myślę, że w Perlu 5.14) z np. (?i-xsm:foo) do (?^i:foo), co sprawia, że ​​parsowanie sprawia ból.

Mogę sprawdzić wersję perl, lub po prostu napisać parser, aby obsłużyć oba przypadki, ale coś mi mówi, że musi być dostępna lepsza metoda introspekcji.

Answer 1

W języku Perl użyjesz re::regexp_pattern.

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

Jak widać ze źródła regexp_pattern, nie ma funkcji API w celu uzyskania tych informacji, więc polecam, aby wywołać tę funkcję także od XS też.

perlcall okładki wywoływania funkcji Perl z C wpadłem na następujący kod nietestowanego:

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

Zastosowanie:

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 

Ale jeśli starają się ograniczać nowsze funkcje, masz dużo więcej do zrobienia niż tylko sprawdzanie/u.