1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
#if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
# define DEBUGGING
# define DEBUGGING_RE_ONLY
#endif
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "re_comp.h"
#undef dXSBOOTARGSXSAPIVERCHK
/* skip API version checking due to different interp struct size but,
this hack is until #123007 is resolved */
#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK
START_EXTERN_C
extern REGEXP* my_re_compile (pTHX_ SV * const pattern, const U32 pm_flags);
extern REGEXP* my_re_op_compile (pTHX_ SV ** const patternp, int pat_count,
OP *expr, const regexp_engine* eng, REGEXP *volatile old_re,
bool *is_bare_re, U32 rx_flags, U32 pm_flags);
extern I32 my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend,
char* strbeg, SSize_t minend, SV* screamer,
void* data, U32 flags);
extern char* my_re_intuit_start(pTHX_
REGEXP * const rx,
SV *sv,
const char * const strbeg,
char *strpos,
char *strend,
const U32 flags,
re_scream_pos_data *data);
extern SV* my_re_intuit_string (pTHX_ REGEXP * const prog);
extern void my_regfree (pTHX_ REGEXP * const r);
extern void my_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren,
SV * const usesv);
extern void my_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
SV const * const value);
extern I32 my_reg_numbered_buff_length(pTHX_ REGEXP * const rx,
const SV * const sv, const I32 paren);
extern SV* my_reg_named_buff(pTHX_ REGEXP * const, SV * const, SV * const,
const U32);
extern SV* my_reg_named_buff_iter(pTHX_ REGEXP * const rx,
const SV * const lastkey, const U32 flags);
extern SV* my_reg_qr_package(pTHX_ REGEXP * const rx);
#if defined(USE_ITHREADS)
extern void* my_regdupe (pTHX_ REGEXP * const r, CLONE_PARAMS *param);
#endif
EXTERN_C const struct regexp_engine my_reg_engine;
EXTERN_C const struct regexp_engine wild_reg_engine;
END_EXTERN_C
const struct regexp_engine my_reg_engine = {
my_re_compile,
my_regexec,
my_re_intuit_start,
my_re_intuit_string,
my_regfree,
my_reg_numbered_buff_fetch,
my_reg_numbered_buff_store,
my_reg_numbered_buff_length,
my_reg_named_buff,
my_reg_named_buff_iter,
my_reg_qr_package,
#if defined(USE_ITHREADS)
my_regdupe,
#endif
my_re_op_compile,
};
/* For use with Unicode property wildcards, when we want to see the compilation
* of the wildcard subpattern, but don't want to see the matching process. All
* but the compilation are the regcomp.c/regexec.c functions which aren't
* subject to 'use re' */
const struct regexp_engine wild_reg_engine = {
my_re_compile,
Perl_regexec_flags,
Perl_re_intuit_start,
Perl_re_intuit_string,
Perl_regfree_internal,
Perl_reg_numbered_buff_fetch,
Perl_reg_numbered_buff_store,
Perl_reg_numbered_buff_length,
Perl_reg_named_buff,
Perl_reg_named_buff_iter,
Perl_reg_qr_package,
#if defined(USE_ITHREADS)
Perl_regdupe_internal,
#endif
my_re_op_compile,
};
MODULE = re PACKAGE = re
void
install()
PPCODE:
PL_colorset = 0; /* Allow reinspection of ENV. */
/* PL_debug |= DEBUG_r_FLAG; */
XPUSHs(sv_2mortal(newSViv(PTR2IV(&my_reg_engine))));
void
regmust(sv)
SV * sv
PROTOTYPE: $
PREINIT:
REGEXP *re;
PPCODE:
{
if ((re = SvRX(sv)) /* assign deliberate */
/* only for re engines we know about */
&& ( RX_ENGINE(re) == &my_reg_engine
|| RX_ENGINE(re) == &wild_reg_engine
|| RX_ENGINE(re) == &PL_core_reg_engine))
{
SV *an = &PL_sv_no;
SV *fl = &PL_sv_no;
if (RX_ANCHORED_SUBSTR(re)) {
an = sv_2mortal(newSVsv(RX_ANCHORED_SUBSTR(re)));
} else if (RX_ANCHORED_UTF8(re)) {
an = sv_2mortal(newSVsv(RX_ANCHORED_UTF8(re)));
}
if (RX_FLOAT_SUBSTR(re)) {
fl = sv_2mortal(newSVsv(RX_FLOAT_SUBSTR(re)));
} else if (RX_FLOAT_UTF8(re)) {
fl = sv_2mortal(newSVsv(RX_FLOAT_UTF8(re)));
}
EXTEND(SP, 2);
PUSHs(an);
PUSHs(fl);
XSRETURN(2);
}
XSRETURN_UNDEF;
}
|
