]> git.vpit.fr Git - perl/modules/re-engine-Plugin.git/blob - Plugin.xs
Initialize all re::engine::Plugin members explicitely
[perl/modules/re-engine-Plugin.git] / Plugin.xs
1 /* This file is part of the re::engine::Plugin Perl module.
2  * See http://search.cpan.org/dist/re-engine-Plugin/ */
3
4 #define PERL_NO_GET_CONTEXT
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8
9 /* --- Helpers ------------------------------------------------------------- */
10
11 #define XSH_PACKAGE "re::engine::Plugin"
12
13 #include "xsh/caps.h"
14 #include "xsh/util.h"
15
16 /* ... Lexical hints ....................................................... */
17
18 typedef struct {
19  SV *comp;
20  SV *exec;
21  SV *free;
22 } xsh_hints_user_t;
23
24 static SV *rep_validate_callback(SV *code) {
25  if (!SvROK(code))
26   return NULL;
27
28  code = SvRV(code);
29  if (SvTYPE(code) < SVt_PVCV)
30   return NULL;
31
32  return SvREFCNT_inc_simple_NN(code);
33 }
34
35 static void xsh_hints_user_init(pTHX_ xsh_hints_user_t *hv, xsh_hints_user_t *v) {
36  hv->comp = rep_validate_callback(v->comp);
37  hv->exec = rep_validate_callback(v->exec);
38  hv->free = rep_validate_callback(v->free);
39
40  return;
41 }
42
43 #if XSH_THREADSAFE
44
45 static void xsh_hints_user_clone(pTHX_ xsh_hints_user_t *nv, xsh_hints_user_t *ov, CLONE_PARAMS *params) {
46  nv->comp = xsh_dup_inc(ov->comp, params);
47  nv->exec = xsh_dup_inc(ov->exec, params);
48  nv->free = xsh_dup_inc(ov->free, params);
49
50  return;
51 }
52
53 #endif /* XSH_THREADSAFE */
54
55 static void xsh_hints_user_deinit(pTHX_ xsh_hints_user_t *hv) {
56  SvREFCNT_dec(hv->comp);
57  SvREFCNT_dec(hv->exec);
58  SvREFCNT_dec(hv->free);
59
60  return;
61 }
62
63 #define rep_hint() xsh_hints_detag(xsh_hints_fetch())
64
65 #define XSH_HINTS_TYPE_USER         1
66 #define XSH_HINTS_ONLY_COMPILE_TIME 0
67
68 #include "xsh/hints.h"
69
70 /* ... Thread-local storage ................................................ */
71
72 #define XSH_THREADS_USER_CONTEXT            0
73 #define XSH_THREADS_USER_LOCAL_SETUP        0
74 #define XSH_THREADS_USER_LOCAL_TEARDOWN     0
75 #define XSH_THREADS_USER_GLOBAL_TEARDOWN    0
76 #define XSH_THREADS_COMPILE_TIME_PROTECTION 0
77
78 #include "xsh/threads.h"
79
80 /* --- Custom regexp engine ------------------------------------------------ */
81
82 /* re__engine__Plugin self; SELF_FROM_PPRIVATE(self,rx->pprivate) */
83 #define SELF_FROM_PPRIVATE(self, pprivate) \
84  if (sv_isobject(pprivate)) {              \
85   SV *ref = SvRV((SV *) pprivate);         \
86   IV  tmp = SvIV((SV *) ref);              \
87   self = INT2PTR(re__engine__Plugin, tmp); \
88  } else {                                  \
89   Perl_croak(aTHX_ "Not an object");       \
90  }
91
92 #if XSH_HAS_PERL(5, 19, 4)
93 # define REP_ENG_EXEC_MINEND_TYPE SSize_t
94 #else
95 # define REP_ENG_EXEC_MINEND_TYPE I32
96 #endif
97
98 START_EXTERN_C
99 EXTERN_C const regexp_engine engine_plugin;
100 #if XSH_HAS_PERL(5, 11, 0)
101 EXTERN_C REGEXP * Plugin_comp(pTHX_ SV * const, U32);
102 #else
103 EXTERN_C REGEXP * Plugin_comp(pTHX_ const SV * const, const U32);
104 #endif
105 EXTERN_C I32      Plugin_exec(pTHX_ REGEXP * const, char *, char *,
106                               char *, REP_ENG_EXEC_MINEND_TYPE, SV *, void *, U32);
107 #if XSH_HAS_PERL(5, 19, 1)
108 EXTERN_C char *   Plugin_intuit(pTHX_ REGEXP * const, SV *, const char * const,
109                                 char *, char *, U32, re_scream_pos_data *);
110 #else
111 EXTERN_C char *   Plugin_intuit(pTHX_ REGEXP * const, SV *, char *,
112                                 char *, U32, re_scream_pos_data *);
113 #endif
114 EXTERN_C SV *     Plugin_checkstr(pTHX_ REGEXP * const);
115 EXTERN_C void     Plugin_free(pTHX_ REGEXP * const);
116 EXTERN_C void *   Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *);
117 EXTERN_C void     Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const,
118                                              const I32, SV * const);
119 EXTERN_C void     Plugin_numbered_buff_STORE(pTHX_ REGEXP * const,
120                                              const I32, SV const * const);
121 EXTERN_C I32      Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const,
122                                               const SV * const, const I32);
123 EXTERN_C SV *     Plugin_named_buff(pTHX_ REGEXP * const, SV * const,
124                                     SV * const, const U32);
125 EXTERN_C SV *     Plugin_named_buff_iter(pTHX_ REGEXP * const, const SV * const,
126                                          const U32);
127 EXTERN_C SV *     Plugin_package(pTHX_ REGEXP * const);
128 #ifdef USE_ITHREADS
129 EXTERN_C void *   Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *);
130 #endif
131
132 EXTERN_C const regexp_engine engine_plugin;
133 END_EXTERN_C
134
135 #define RE_ENGINE_PLUGIN (&engine_plugin)
136 const regexp_engine engine_plugin = {
137  Plugin_comp,
138  Plugin_exec,
139  Plugin_intuit,
140  Plugin_checkstr,
141  Plugin_free,
142  Plugin_numbered_buff_FETCH,
143  Plugin_numbered_buff_STORE,
144  Plugin_numbered_buff_LENGTH,
145  Plugin_named_buff,
146  Plugin_named_buff_iter,
147  Plugin_package
148 #if defined(USE_ITHREADS)
149  , Plugin_dupe
150 #endif
151 #if XSH_HAS_PERL(5, 17, 0)
152  , 0
153 #endif
154 };
155
156 typedef struct replug {
157  /* Pointer back to the containing regexp struct so that accessors
158   * can modify nparens, gofs, etc... */
159  struct regexp *rx;
160
161  /* A copy of the pattern given to comp, for ->pattern */
162  SV *pattern;
163
164  /* A copy of the string being matched against, for ->str */
165  SV *str;
166
167  /* The ->stash */
168  SV *stash;
169
170  /* Callbacks */
171  SV *cb_exec;
172  SV *cb_free;
173
174  /* ->num_captures */
175  SV *cb_num_capture_buff_FETCH;
176  SV *cb_num_capture_buff_STORE;
177  SV *cb_num_capture_buff_LENGTH;
178 } *re__engine__Plugin;
179
180 #if XSH_HAS_PERL(5, 11, 0)
181 # define rxREGEXP(RX)  (SvANY(RX))
182 # define newREGEXP(RX) ((RX) = ((REGEXP *) newSV_type(SVt_REGEXP)))
183 #else
184 # define rxREGEXP(RX)  (RX)
185 # define newREGEXP(RX) (Newxz((RX), 1, struct regexp))
186 #endif
187
188 REGEXP *
189 #if XSH_HAS_PERL(5, 11, 0)
190 Plugin_comp(pTHX_ SV * const pattern, U32 flags)
191 #else
192 Plugin_comp(pTHX_ const SV * const pattern, const U32 flags)
193 #endif
194 {
195  dSP;
196  struct regexp *rx;
197  REGEXP *RX;
198
199  re__engine__Plugin re;
200  const xsh_hints_user_t *h;
201
202  STRLEN plen;
203  char *pbuf;
204
205  SV *obj;
206
207  h = rep_hint();
208  if (!h) /* This looks like a pragma leak. Apply the default behaviour */
209   return re_compile(pattern, flags);
210
211  /* exp/xend version of the pattern & length */
212  pbuf = SvPV((SV *) pattern, plen);
213
214  /* Our blessed object */
215  obj = newSV(0);
216  Newx(re, 1, struct replug);
217  sv_setref_pv(obj, XSH_PACKAGE, (void *) re);
218
219  newREGEXP(RX);
220  rx = rxREGEXP(RX);
221
222  re->rx       = rx;               /* Make the rx accessible from self->rx */
223  rx->intflags = flags;            /* Flags for internal use */
224  rx->extflags = flags;            /* Flags for perl to use */
225  rx->engine   = RE_ENGINE_PLUGIN; /* Compile to use this engine */
226
227 #if !XSH_HAS_PERL(5, 11, 0)
228  rx->refcnt   = 1;                /* Refcount so we won't be destroyed */
229
230  /* Precompiled pattern for pp_regcomp to use */
231  rx->prelen   = plen;
232  rx->precomp  = savepvn(pbuf, rx->prelen);
233
234  /* Set up qr// stringification to be equivalent to the supplied
235   * pattern, this should be done via overload eventually */
236  rx->wraplen  = rx->prelen;
237  Newx(rx->wrapped, rx->wraplen, char);
238  Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
239 #endif
240
241  /* Store our private object */
242  rx->pprivate = obj;
243
244  /* Store the pattern for ->pattern */
245  re->pattern  = (SV *) pattern;
246  SvREFCNT_inc_simple_void(re->pattern);
247
248  re->str   = NULL;
249  re->stash = NULL;
250
251  /* Store the default exec callback (which may be NULL) into the regexp
252   * object. */
253  re->cb_exec = h->exec;
254  SvREFCNT_inc_simple_void(h->exec);
255
256  /* Same goes for the free callback. */
257  re->cb_free = h->free;
258  SvREFCNT_inc_simple_void(h->free);
259
260  re->cb_num_capture_buff_FETCH  = NULL;
261  re->cb_num_capture_buff_STORE  = NULL;
262  re->cb_num_capture_buff_LENGTH = NULL;
263
264  /* Call our callback function if one was defined, if not we've already set up
265   * all the stuff we're going to to need for subsequent exec and other calls */
266  if (h->comp) {
267   ENTER;
268   SAVETMPS;
269
270   PUSHMARK(SP);
271   XPUSHs(obj);
272   PUTBACK;
273
274   call_sv(h->comp, G_DISCARD);
275
276   FREETMPS;
277   LEAVE;
278  }
279
280  /* If any of the comp-time accessors were called we'll have to
281   * update the regexp struct with the new info */
282  Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
283
284  return RX;
285 }
286
287 I32
288 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
289             char *strbeg, REP_ENG_EXEC_MINEND_TYPE minend,
290             SV *sv, void *data, U32 flags)
291 {
292  struct regexp *rx;
293  re__engine__Plugin self;
294  I32 matched;
295
296  rx = rxREGEXP(RX);
297  SELF_FROM_PPRIVATE(self, rx->pprivate);
298
299  if (self->cb_exec) {
300   SV *ret;
301   dSP;
302
303   /* Store the current str for ->str */
304   SvREFCNT_dec(self->str);
305   self->str = sv;
306   SvREFCNT_inc_simple_void(self->str);
307
308   ENTER;
309   SAVETMPS;
310
311   PUSHMARK(SP);
312   XPUSHs(rx->pprivate);
313   XPUSHs(sv);
314   PUTBACK;
315
316   call_sv(self->cb_exec, G_SCALAR);
317
318   SPAGAIN;
319
320   ret = POPs;
321   if (SvTRUE(ret))
322    matched = 1;
323   else
324    matched = 0;
325
326   PUTBACK;
327   FREETMPS;
328   LEAVE;
329  } else {
330   matched = 0;
331  }
332
333  return matched;
334 }
335
336 char *
337 #if XSH_HAS_PERL(5, 19, 1)
338 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, const char * const strbeg,
339               char *strpos, char *strend, U32 flags, re_scream_pos_data *data)
340 #else
341 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos,
342               char *strend, U32 flags, re_scream_pos_data *data)
343 #endif
344 {
345  PERL_UNUSED_ARG(RX);
346  PERL_UNUSED_ARG(sv);
347 #if XSH_HAS_PERL(5, 19, 1)
348  PERL_UNUSED_ARG(strbeg);
349 #endif
350  PERL_UNUSED_ARG(strpos);
351  PERL_UNUSED_ARG(strend);
352  PERL_UNUSED_ARG(flags);
353  PERL_UNUSED_ARG(data);
354
355  return NULL;
356 }
357
358 SV *
359 Plugin_checkstr(pTHX_ REGEXP * const RX)
360 {
361  PERL_UNUSED_ARG(RX);
362
363  return NULL;
364 }
365
366 void
367 Plugin_free(pTHX_ REGEXP * const RX)
368 {
369  struct regexp *rx;
370  re__engine__Plugin self;
371  SV *callback;
372  dSP;
373
374  if (PL_dirty)
375   return;
376
377  rx = rxREGEXP(RX);
378  SELF_FROM_PPRIVATE(self, rx->pprivate);
379
380  callback = self->cb_free;
381
382  if (callback) {
383   ENTER;
384   SAVETMPS;
385
386   PUSHMARK(SP);
387   XPUSHs(rx->pprivate);
388   PUTBACK;
389
390   call_sv(callback, G_DISCARD);
391
392   PUTBACK;
393   FREETMPS;
394   LEAVE;
395  }
396
397  SvREFCNT_dec(self->pattern);
398  SvREFCNT_dec(self->str);
399  SvREFCNT_dec(self->stash);
400
401  SvREFCNT_dec(self->cb_exec);
402
403  SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
404  SvREFCNT_dec(self->cb_num_capture_buff_STORE);
405  SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
406
407  self->rx = NULL;
408
409  Safefree(self);
410
411  SvREFCNT_dec(rx->pprivate);
412
413  return;
414 }
415
416 void *
417 Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param)
418 {
419  struct regexp *rx = rxREGEXP(RX);
420
421  Perl_croak(aTHX_ "dupe not supported yet");
422
423  return rx->pprivate;
424 }
425
426
427 void
428 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
429                            SV * const sv)
430 {
431  struct regexp *rx;
432  re__engine__Plugin self;
433  SV *callback;
434
435  rx = rxREGEXP(RX);
436  SELF_FROM_PPRIVATE(self, rx->pprivate);
437
438  callback = self->cb_num_capture_buff_FETCH;
439
440  if (callback) {
441   I32 items;
442   dSP;
443
444   ENTER;
445   SAVETMPS;
446
447   PUSHMARK(SP);
448   XPUSHs(rx->pprivate);
449   mXPUSHi(paren);
450   PUTBACK;
451
452   items = call_sv(callback, G_SCALAR);
453
454   if (items == 1) {
455    SV *ret;
456    SPAGAIN;
457    ret = POPs;
458    sv_setsv(sv, ret);
459   } else {
460    sv_setsv(sv, &PL_sv_undef);
461   }
462
463   PUTBACK;
464   FREETMPS;
465   LEAVE;
466  } else {
467   sv_setsv(sv, &PL_sv_undef);
468  }
469 }
470
471 void
472 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
473                            SV const * const value)
474 {
475  struct regexp *rx;
476  re__engine__Plugin self;
477  SV *callback;
478
479  rx = rxREGEXP(RX);
480  SELF_FROM_PPRIVATE(self, rx->pprivate);
481
482  callback = self->cb_num_capture_buff_STORE;
483
484  if (callback) {
485   dSP;
486
487   ENTER;
488   SAVETMPS;
489
490   PUSHMARK(SP);
491   XPUSHs(rx->pprivate);
492   mXPUSHi(paren);
493   XPUSHs((SV *) value);
494   PUTBACK;
495
496   call_sv(callback, G_DISCARD);
497
498   PUTBACK;
499   FREETMPS;
500   LEAVE;
501  }
502 }
503
504 I32
505 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
506                             const I32 paren)
507 {
508  struct regexp *rx;
509  re__engine__Plugin self;
510  SV *callback;
511
512  rx = rxREGEXP(RX);
513  SELF_FROM_PPRIVATE(self, rx->pprivate);
514
515  callback = self->cb_num_capture_buff_LENGTH;
516
517  if (callback) {
518   IV ret;
519   dSP;
520
521   ENTER;
522   SAVETMPS;
523
524   PUSHMARK(SP);
525   XPUSHs(rx->pprivate);
526   mXPUSHi(paren);
527   PUTBACK;
528
529   call_sv(callback, G_SCALAR);
530
531   SPAGAIN;
532
533   ret = POPi;
534
535   PUTBACK;
536   FREETMPS;
537   LEAVE;
538
539   return (I32) ret;
540  } else {
541   /* TODO: call FETCH and get the length on that value */
542   return 0;
543  }
544 }
545
546 SV *
547 Plugin_named_buff(pTHX_ REGEXP * const RX, SV * const key, SV * const value,
548                   const U32 flags)
549 {
550  return NULL;
551 }
552
553 SV *
554 Plugin_named_buff_iter(pTHX_ REGEXP * const RX, const SV * const lastkey,
555                        const U32 flags)
556 {
557  return NULL;
558 }
559
560 SV *
561 Plugin_package(pTHX_ REGEXP * const RX)
562 {
563  PERL_UNUSED_ARG(RX);
564
565  return newSVpvs(XSH_PACKAGE);
566 }
567
568 static void xsh_user_global_setup(pTHX) {
569  HV *stash;
570
571  stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1);
572  newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(XSH_THREADSAFE));
573  newCONSTSUB(stash, "REP_FORKSAFE",   newSVuv(XSH_FORKSAFE));
574
575  return;
576 }
577
578 /* --- XS ------------------------------------------------------------------ */
579
580 MODULE = re::engine::Plugin       PACKAGE = re::engine::Plugin
581
582 PROTOTYPES: DISABLE
583
584 BOOT:
585 {
586  xsh_setup();
587 }
588
589 #if XSH_THREADSAFE
590
591 void
592 CLONE(...)
593 PPCODE:
594  xsh_clone();
595  XSRETURN(0);
596
597 #endif /* XSH_THREADSAFE */
598
599 void
600 pattern(re::engine::Plugin self, ...)
601 PPCODE:
602  XPUSHs(self->pattern);
603  XSRETURN(1);
604
605 void
606 str(re::engine::Plugin self, ...)
607 PPCODE:
608  XPUSHs(self->str);
609  XSRETURN(1);
610
611 void
612 mod(re::engine::Plugin self)
613 PREINIT:
614  U32 flags;
615  char mods[5 + 1];
616  int n = 0, i;
617 PPCODE:
618  flags = self->rx->intflags;
619  if (flags & PMf_FOLD)         /* /i */
620   mods[n++] = 'i';
621  if (flags & PMf_MULTILINE)    /* /m */
622   mods[n++] = 'm';
623  if (flags & PMf_SINGLELINE)   /* /s */
624   mods[n++] = 's';
625  if (flags & PMf_EXTENDED)     /* /x */
626   mods[n++] = 'x';
627  if (flags & RXf_PMf_KEEPCOPY) /* /p */
628   mods[n++] = 'p';
629  mods[n] = '\0';
630  EXTEND(SP, 2 * n);
631  for (i = 0; i < n; ++i) {
632   mPUSHp(mods + i, 1);
633   PUSHs(&PL_sv_yes);
634  }
635  XSRETURN(2 * n);
636
637 void
638 stash(re::engine::Plugin self, ...)
639 PPCODE:
640  if (items > 1) {
641   SvREFCNT_dec(self->stash);
642   self->stash = ST(1);
643   SvREFCNT_inc_simple_void(self->stash);
644   XSRETURN_EMPTY;
645  } else {
646   XPUSHs(self->stash);
647   XSRETURN(1);
648  }
649
650 void
651 minlen(re::engine::Plugin self, ...)
652 PPCODE:
653  if (items > 1) {
654   self->rx->minlen = (I32)SvIV(ST(1));
655   XSRETURN_EMPTY;
656  } else if (self->rx->minlen) {
657   mXPUSHi(self->rx->minlen);
658   XSRETURN(1);
659  } else {
660   XSRETURN_UNDEF;
661  }
662
663 void
664 gofs(re::engine::Plugin self, ...)
665 PPCODE:
666  if (items > 1) {
667   self->rx->gofs = (U32)SvIV(ST(1));
668   XSRETURN_EMPTY;
669  } else if (self->rx->gofs) {
670   mXPUSHu(self->rx->gofs);
671   XSRETURN(1);
672  } else {
673   XSRETURN_UNDEF;
674  }
675
676 void
677 nparens(re::engine::Plugin self, ...)
678 PPCODE:
679  if (items > 1) {
680   self->rx->nparens = (U32)SvIV(ST(1));
681   XSRETURN_EMPTY;
682  } else if (self->rx->nparens) {
683   mXPUSHu(self->rx->nparens);
684   XSRETURN(1);
685  } else {
686   XSRETURN_UNDEF;
687  }
688
689 void
690 _exec(re::engine::Plugin self, ...)
691 PPCODE:
692  if (items > 1) {
693   SvREFCNT_dec(self->cb_exec);
694   self->cb_exec = ST(1);
695   SvREFCNT_inc_simple_void(self->cb_exec);
696  }
697  XSRETURN(0);
698
699 void
700 _free(re::engine::Plugin self, ...)
701 PPCODE:
702  if (items > 1) {
703   SvREFCNT_dec(self->cb_free);
704   self->cb_free = ST(1);
705   SvREFCNT_inc_simple_void(self->cb_free);
706  }
707  XSRETURN(0);
708
709 void
710 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
711 PPCODE:
712  if (items > 1) {
713   SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
714   self->cb_num_capture_buff_FETCH = ST(1);
715   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH);
716  }
717  XSRETURN(0);
718
719 void
720 _num_capture_buff_STORE(re::engine::Plugin self, ...)
721 PPCODE:
722  if (items > 1) {
723   SvREFCNT_dec(self->cb_num_capture_buff_STORE);
724   self->cb_num_capture_buff_STORE = ST(1);
725   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE);
726  }
727  XSRETURN(0);
728
729 void
730 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
731 PPCODE:
732  if (items > 1) {
733   SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
734   self->cb_num_capture_buff_LENGTH = ST(1);
735   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH);
736  }
737  XSRETURN(0);
738
739 SV *
740 _tag(SV *comp, SV *exec, SV *free)
741 PREINIT:
742  xsh_hints_user_t arg;
743 CODE:
744  arg.comp = comp;
745  arg.exec = exec;
746  arg.free = free;
747  RETVAL = xsh_hints_tag(&arg);
748 OUTPUT:
749  RETVAL
750
751 void
752 ENGINE()
753 PPCODE:
754  mXPUSHi(PTR2IV(&engine_plugin));
755  XSRETURN(1);