我正在处理一些需要序列化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
的版本,或者只是编写解析器来处理这两种情况,但有些事情告诉我必须有一种更好的内省方法可用。
在 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涵盖了从C调用Perl函数。我想出了以下未经测试的代码:
/* 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);
use Data::Dump::Streamer ':util';
my ($pattern, $flags) = regex( qr/foo/i );
print "pattern: $pattern, flags: $flagsn";
# pattern: foo, flags: i
但是,如果您尝试限制更新的功能,则除了检查/u 之外,您还有很多工作要做。