this OPf_SPECIAL was bollocks. remove it.
[p5sagit/Devel-Declare.git] / Declare.xs
CommitLineData
94caac6e 1#define PERL_CORE
2#define PERL_NO_GET_CONTEXT
94caac6e 3#include "EXTERN.h"
4#include "perl.h"
5#include "XSUB.h"
6#undef printf
e807ee50 7#include "stolen_chunk_of_toke.c"
94caac6e 8#include <stdio.h>
9#include <string.h>
10
0f070758 11#define DD_HAS_TRAITS
53e3ab32 12#if 0
13#define DD_DEBUG
14#endif
c630715a 15
0ba8c7aa 16#define DD_HANDLE_NAME 1
17#define DD_HANDLE_PROTO 2
15d0d014 18#define DD_HANDLE_PACKAGE 8
0ba8c7aa 19
c630715a 20#ifdef DD_DEBUG
21#define DD_DEBUG_S printf("Buffer: %s\n", s);
22#else
23#define DD_DEBUG_S
24#endif
25
94caac6e 26#define LEX_NORMAL 10
27#define LEX_INTERPNORMAL 9
28
29/* placeholders for PL_check entries we wrap */
30
31STATIC OP *(*dd_old_ck_rv2cv)(pTHX_ OP *op);
b7505981 32STATIC OP *(*dd_old_ck_entereval)(pTHX_ OP *op);
94caac6e 33
34/* flag to trigger removal of temporary declaree sub */
35
36static int in_declare = 0;
37
38/* replacement PL_check rv2cv entry */
39
40STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) {
41 OP* kid;
42 char* s;
0ba8c7aa 43 char* save_s;
94caac6e 44 char tmpbuf[sizeof PL_tokenbuf];
0ba8c7aa 45 char found_name[sizeof PL_tokenbuf];
0f070758 46 char* found_proto = NULL, *found_traits = NULL;
0ba8c7aa 47 STRLEN len = 0;
94caac6e 48 HV *stash;
49 HV* is_declarator;
50 SV** is_declarator_pack_ref;
51 HV* is_declarator_pack_hash;
52 SV** is_declarator_flag_ref;
0ba8c7aa 53 int dd_flags;
9026391e 54 char* cb_args[6];
53e3ab32 55 dSP; /* define stack pointer for later call stuff */
56 char* retstr;
57 STRLEN n_a; /* for POPpx */
94caac6e 58
59 o = dd_old_ck_rv2cv(aTHX_ o); /* let the original do its job */
60
61 if (in_declare) {
62 cb_args[0] = NULL;
dcca2c59 63#ifdef DD_DEBUG
64 printf("Deconstructing declare\n");
65 printf("PL_bufptr: %s\n", PL_bufptr);
66 printf("bufend at: %i\n", PL_bufend - PL_bufptr);
67 printf("linestr: %s\n", SvPVX(PL_linestr));
68 printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
69#endif
94caac6e 70 call_argv("Devel::Declare::done_declare", G_VOID|G_DISCARD, cb_args);
0ba8c7aa 71 in_declare--;
dcca2c59 72#ifdef DD_DEBUG
73 printf("PL_bufptr: %s\n", PL_bufptr);
74 printf("bufend at: %i\n", PL_bufend - PL_bufptr);
75 printf("linestr: %s\n", SvPVX(PL_linestr));
76 printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
77 printf("actual len: %i\n", strlen(PL_bufptr));
78#endif
94caac6e 79 return o;
80 }
81
82 kid = cUNOPo->op_first;
83
84 if (kid->op_type != OP_GV) /* not a GV so ignore */
85 return o;
86
87 if (PL_lex_state != LEX_NORMAL && PL_lex_state != LEX_INTERPNORMAL)
88 return o; /* not lexing? */
89
90 stash = GvSTASH(kGVOP_gv);
91
c630715a 92#ifdef DD_DEBUG
93 printf("Checking GV %s -> %s\n", HvNAME(stash), GvNAME(kGVOP_gv));
94#endif
94caac6e 95
96 is_declarator = get_hv("Devel::Declare::declarators", FALSE);
97
98 if (!is_declarator)
99 return o;
100
101 is_declarator_pack_ref = hv_fetch(is_declarator, HvNAME(stash),
102 strlen(HvNAME(stash)), FALSE);
103
104 if (!is_declarator_pack_ref || !SvROK(*is_declarator_pack_ref))
105 return o; /* not a hashref */
106
107 is_declarator_pack_hash = (HV*) SvRV(*is_declarator_pack_ref);
108
109 is_declarator_flag_ref = hv_fetch(is_declarator_pack_hash, GvNAME(kGVOP_gv),
110 strlen(GvNAME(kGVOP_gv)), FALSE);
111
0ba8c7aa 112 /* requires SvIOK as well as TRUE since flags not being an int is useless */
113
114 if (!is_declarator_flag_ref
115 || !SvIOK(*is_declarator_flag_ref)
116 || !SvTRUE(*is_declarator_flag_ref))
94caac6e 117 return o;
118
0ba8c7aa 119 dd_flags = SvIVX(*is_declarator_flag_ref);
120
121#ifdef DD_DEBUG
122 printf("dd_flags are: %i\n", dd_flags);
123#endif
124
94caac6e 125 s = PL_bufptr; /* copy the current buffer pointer */
126
c630715a 127 DD_DEBUG_S
128
129#ifdef DD_DEBUG
0ba8c7aa 130 printf("PL_tokenbuf: %s\n", PL_tokenbuf);
c630715a 131#endif
132
133 /*
134 * buffer will be at the beginning of the declarator, -unless- the
135 * declarator is at EOL in which case it'll be the next useful line
136 * so we don't short-circuit out if we don't find the declarator
137 */
138
94caac6e 139 while (s < PL_bufend && isSPACE(*s)) s++;
140 if (memEQ(s, PL_tokenbuf, strlen(PL_tokenbuf)))
141 s += strlen(PL_tokenbuf);
c630715a 142
143 DD_DEBUG_S
94caac6e 144
0ba8c7aa 145 if (dd_flags & DD_HANDLE_NAME) {
94caac6e 146
0ba8c7aa 147 /* find next word */
94caac6e 148
0ba8c7aa 149 s = skipspace(s);
c630715a 150
0ba8c7aa 151 DD_DEBUG_S
94caac6e 152
15d0d014 153 /* arg 4 is allow_package */
94caac6e 154
15d0d014 155 s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len);
0ba8c7aa 156
157 DD_DEBUG_S
c630715a 158
0ba8c7aa 159 if (len) {
160 strcpy(found_name, tmpbuf);
161#ifdef DD_DEBUG
162 printf("Found %s\n", found_name);
163#endif
164 }
165 }
166
167 if (dd_flags & DD_HANDLE_PROTO) {
168
169 s = skipspace(s);
170
171 if (*s == '(') { /* found a prototype-ish thing */
172 save_s = s;
173 s = scan_str(s, FALSE, FALSE); /* no keep_quoted, no keep_delims */
0f070758 174#ifdef DD_HAS_TRAITS
175 {
176 char *traitstart = s = skipspace(s);
177
178 while (*s && *s != '{') ++s;
179 if (*s) {
180 int tlen = s - traitstart;
f5262149 181 New(0, found_traits, tlen+1, char);
0f070758 182 Copy(traitstart, found_traits, tlen, char);
183 found_traits[tlen] = 0;
184#ifdef DD_DEBUG
185 printf("found traits..... (%s)\n", found_traits);
186#endif
187 }
188 }
189#endif
190
0ba8c7aa 191 if (SvPOK(PL_lex_stuff)) {
192#ifdef DD_DEBUG
193 printf("Found proto %s\n", SvPVX(PL_lex_stuff));
194#endif
195 found_proto = SvPVX(PL_lex_stuff);
53e3ab32 196 if (len) /* foo name () => foo name X, only foo parsed so works */
197 *save_s++ = ' ';
198 else /* foo () => foo =X, TOKEN('&') won't handle foo X */
199 *save_s++ = '=';
0ba8c7aa 200 *save_s++ = 'X';
201 while (save_s < s) {
202 *save_s++ = ' ';
203 }
204#ifdef DD_DEBUG
205 printf("Curbuf %s\n", PL_bufptr);
206#endif
207 }
208 }
209 }
210
53e3ab32 211 if (!len)
212 found_name[0] = 0;
213
214#ifdef DD_DEBUG
215 printf("Calling init_declare\n");
216#endif
217 cb_args[0] = HvNAME(stash);
218 cb_args[1] = GvNAME(kGVOP_gv);
9026391e 219 cb_args[2] = HvNAME(PL_curstash);
220 cb_args[3] = found_name;
221 cb_args[4] = found_proto;
0f070758 222 cb_args[5] = found_traits;
223 cb_args[6] = NULL;
53e3ab32 224
225 if (len && found_proto)
226 in_declare = 2;
227 else if (len || found_proto)
228 in_declare = 1;
229 if (found_proto)
230 PL_lex_stuff = Nullsv;
231 s = skipspace(s);
232#ifdef DD_DEBUG
233 printf("cur buf: %s\n", s);
234 printf("bufend at: %i\n", PL_bufend - s);
235 printf("linestr: %s\n", SvPVX(PL_linestr));
236 printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
237#endif
238 if (*s++ == '{') {
239 call_argv("Devel::Declare::init_declare", G_SCALAR, cb_args);
240 SPAGAIN;
241 retstr = POPpx;
242 PUTBACK;
243 if (retstr && strlen(retstr)) {
dcca2c59 244 const char* old_start = SvPVX(PL_linestr);
245 int start_diff;
c5912dc7 246 const int old_len = SvCUR(PL_linestr);
0ba8c7aa 247#ifdef DD_DEBUG
53e3ab32 248 printf("Got string %s\n", retstr);
0ba8c7aa 249#endif
c5912dc7 250 SvGROW(PL_linestr, (STRLEN)(old_len + strlen(retstr)));
dcca2c59 251 if (start_diff = SvPVX(PL_linestr) - old_start) {
8314c6b3 252 Perl_croak(aTHX_ "forced to realloc PL_linestr for line %s, bailing out before we crash harder", SvPVX(PL_linestr));
dcca2c59 253 }
53e3ab32 254 memmove(s+strlen(retstr), s, (PL_bufend - s)+1);
255 memmove(s, retstr, strlen(retstr));
c5912dc7 256 SvCUR_set(PL_linestr, old_len + strlen(retstr));
53e3ab32 257 PL_bufend += strlen(retstr);
258#ifdef DD_DEBUG
259 printf("cur buf: %s\n", s);
dcca2c59 260 printf("PL_bufptr: %s\n", PL_bufptr);
53e3ab32 261 printf("bufend at: %i\n", PL_bufend - s);
262 printf("linestr: %s\n", SvPVX(PL_linestr));
263 printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
dcca2c59 264 printf("tokenbuf now: %s\n", PL_tokenbuf);
53e3ab32 265#endif
266 }
267 } else {
94caac6e 268 call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args);
94caac6e 269 }
53e3ab32 270 return o;
271}
272
b7505981 273OP* dd_pp_entereval(pTHX) {
274 dSP;
275 dPOPss;
276 STRLEN len;
277 const char* s;
278 if (SvPOK(sv)) {
53e3ab32 279#ifdef DD_DEBUG
b7505981 280 printf("mangling eval sv\n");
53e3ab32 281#endif
b7505981 282 if (SvREADONLY(sv))
283 sv = sv_2mortal(newSVsv(sv));
284 s = SvPVX(sv);
285 len = SvCUR(sv);
286 if (!len || s[len-1] != ';') {
287 if (!(SvFLAGS(sv) & SVs_TEMP))
288 sv = sv_2mortal(newSVsv(sv));
289 sv_catpvn(sv, "\n;", 2);
53e3ab32 290 }
b7505981 291 SvGROW(sv, 8192);
53e3ab32 292 }
b7505981 293 PUSHs(sv);
294 return PL_ppaddr[OP_ENTEREVAL](aTHX);
295}
53e3ab32 296
b7505981 297STATIC OP *dd_ck_entereval(pTHX_ OP *o) {
298 o = dd_old_ck_entereval(aTHX_ o); /* let the original do its job */
b7505981 299 o->op_ppaddr = dd_pp_entereval;
94caac6e 300 return o;
301}
302
6a0bcf35 303static I32 dd_filter_realloc(pTHX_ int idx, SV *sv, int maxlen)
304{
305 const I32 count = FILTER_READ(idx+1, sv, maxlen);
306 SvGROW(sv, 8192); /* please try not to have a line longer than this :) */
307 /* filter_del(dd_filter_realloc); */
308 return count;
309}
310
94caac6e 311static int initialized = 0;
312
313MODULE = Devel::Declare PACKAGE = Devel::Declare
314
315PROTOTYPES: DISABLE
316
317void
318setup()
319 CODE:
320 if (!initialized++) {
321 dd_old_ck_rv2cv = PL_check[OP_RV2CV];
322 PL_check[OP_RV2CV] = dd_ck_rv2cv;
b7505981 323 dd_old_ck_entereval = PL_check[OP_ENTEREVAL];
324 PL_check[OP_ENTEREVAL] = dd_ck_entereval;
94caac6e 325 }
6a0bcf35 326 filter_add(dd_filter_realloc, NULL);