Как исследовать регулярные выражения в Perl API

Я работаю над некоторым кодом, который должен сериализовать регулярные выражения Perl, включая любые флаги регулярных выражений. Поддерживается только подмножество флагов, поэтому мне нужно определить, когда неподдерживаемые флаги, такие как /u, находятся в объекте регулярного выражения.

Текущая версия кода делает это:

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

Затем вручную обрабатывает string символ за символом, чтобы найти флаги.

Проблема здесь в том, что строковое определение флагов регулярных выражений изменилось (я думаю, в Perl 5.14), например. (?i-xsm:foo) в (?^i:foo), что затрудняет синтаксический анализ.

Я мог бы проверить версию perl или просто написать синтаксический анализатор для обработки обоих случаев, но что-то мне подсказывает, что должен быть доступный более совершенный метод самоанализа.


c regex introspection perl xs
person friedo    schedule 07.08.2012    source источник

Ответы (2)


arrow_upward
6
arrow_downward

В Perl вы бы использовали re::regexp_pattern.

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

Как видно из исходного кода regexp_pattern, в API нет функции для получения этой информации, поэтому я рекомендую вам вызывать эту функцию и из XS.

perlcall охватывает вызов функций Perl из C. Я придумал следующий непроверенный код:

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

Использование:

SV * re = ...;

char * pat;
char * flags;
regexp_pattern(&pat, &flags, re);
person ikegami    schedule 07.08.2012
comment
Спасибо, @ikegami. Я смог получить то, что мне нужно, с вашим кодом C в качестве отправной точки. Следует отметить, что возвращаемые значения должны извлекаться в обратном порядке (поэтому flags_sv появляется первым, а не вторым). - person friedo; 08.08.2012

arrow_upward
3
arrow_downward 

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

Но если вы пытаетесь ограничить более свежие функции, у вас будет гораздо больше работы, чем просто проверка /u.

person ysth    schedule 07.08.2012