]> git.vpit.fr Git - perl/modules/re-engine-Plugin.git/blob - Plugin.xs
A few more declarations adjustments
[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  const xsh_hints_user_t *h;
196  REGEXP            *RX;
197  struct regexp     *rx;
198  re__engine__Plugin re;
199  char  *pbuf;
200  STRLEN plen;
201  SV    *obj;
202
203  h = rep_hint();
204  if (!h) /* This looks like a pragma leak. Apply the default behaviour */
205   return re_compile(pattern, flags);
206
207  /* exp/xend version of the pattern & length */
208  pbuf = SvPV((SV *) pattern, plen);
209
210  /* Our blessed object */
211  obj = newSV(0);
212  Newx(re, 1, struct replug);
213  sv_setref_pv(obj, XSH_PACKAGE, (void *) re);
214
215  newREGEXP(RX);
216  rx = rxREGEXP(RX);
217
218  re->rx       = rx;               /* Make the rx accessible from self->rx */
219  rx->intflags = flags;            /* Flags for internal use */
220  rx->extflags = flags;            /* Flags for perl to use */
221  rx->engine   = RE_ENGINE_PLUGIN; /* Compile to use this engine */
222
223 #if !XSH_HAS_PERL(5, 11, 0)
224  rx->refcnt   = 1;                /* Refcount so we won't be destroyed */
225
226  /* Precompiled pattern for pp_regcomp to use */
227  rx->prelen   = plen;
228  rx->precomp  = savepvn(pbuf, rx->prelen);
229
230  /* Set up qr// stringification to be equivalent to the supplied
231   * pattern, this should be done via overload eventually */
232  rx->wraplen  = rx->prelen;
233  Newx(rx->wrapped, rx->wraplen, char);
234  Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
235 #endif
236
237  /* Store our private object */
238  rx->pprivate = obj;
239
240  /* Store the pattern for ->pattern */
241  re->pattern  = (SV *) pattern;
242  SvREFCNT_inc_simple_void(re->pattern);
243
244  re->str   = NULL;
245  re->stash = NULL;
246
247  /* Store the default exec callback (which may be NULL) into the regexp
248   * object. */
249  re->cb_exec = h->exec;
250  SvREFCNT_inc_simple_void(h->exec);
251
252  /* Same goes for the free callback. */
253  re->cb_free = h->free;
254  SvREFCNT_inc_simple_void(h->free);
255
256  re->cb_num_capture_buff_FETCH  = NULL;
257  re->cb_num_capture_buff_STORE  = NULL;
258  re->cb_num_capture_buff_LENGTH = NULL;
259
260  /* Call our callback function if one was defined, if not we've already set up
261   * all the stuff we're going to to need for subsequent exec and other calls */
262  if (h->comp) {
263   dSP;
264
265   ENTER;
266   SAVETMPS;
267
268   PUSHMARK(SP);
269   XPUSHs(obj);
270   PUTBACK;
271
272   call_sv(h->comp, G_DISCARD);
273
274   FREETMPS;
275   LEAVE;
276  }
277
278  /* If any of the comp-time accessors were called we'll have to
279   * update the regexp struct with the new info */
280  Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
281
282  return RX;
283 }
284
285 I32
286 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
287             char *strbeg, REP_ENG_EXEC_MINEND_TYPE minend,
288             SV *sv, void *data, U32 flags)
289 {
290  struct regexp     *rx;
291  re__engine__Plugin self;
292  I32 matched;
293
294  rx = rxREGEXP(RX);
295  SELF_FROM_PPRIVATE(self, rx->pprivate);
296
297  if (self->cb_exec) {
298   SV *ret;
299   dSP;
300
301   /* Store the current str for ->str */
302   SvREFCNT_dec(self->str);
303   self->str = sv;
304   SvREFCNT_inc_simple_void(self->str);
305
306   ENTER;
307   SAVETMPS;
308
309   PUSHMARK(SP);
310   XPUSHs(rx->pprivate);
311   XPUSHs(sv);
312   PUTBACK;
313
314   call_sv(self->cb_exec, G_SCALAR);
315
316   SPAGAIN;
317
318   ret = POPs;
319   if (SvTRUE(ret))
320    matched = 1;
321   else
322    matched = 0;
323
324   PUTBACK;
325   FREETMPS;
326   LEAVE;
327  } else {
328   matched = 0;
329  }
330
331  return matched;
332 }
333
334 char *
335 #if XSH_HAS_PERL(5, 19, 1)
336 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, const char * const strbeg,
337               char *strpos, char *strend, U32 flags, re_scream_pos_data *data)
338 #else
339 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos,
340               char *strend, U32 flags, re_scream_pos_data *data)
341 #endif
342 {
343  PERL_UNUSED_ARG(RX);
344  PERL_UNUSED_ARG(sv);
345 #if XSH_HAS_PERL(5, 19, 1)
346  PERL_UNUSED_ARG(strbeg);
347 #endif
348  PERL_UNUSED_ARG(strpos);
349  PERL_UNUSED_ARG(strend);
350  PERL_UNUSED_ARG(flags);
351  PERL_UNUSED_ARG(data);
352
353  return NULL;
354 }
355
356 SV *
357 Plugin_checkstr(pTHX_ REGEXP * const RX)
358 {
359  PERL_UNUSED_ARG(RX);
360
361  return NULL;
362 }
363
364 void
365 Plugin_free(pTHX_ REGEXP * const RX)
366 {
367  struct regexp     *rx;
368  re__engine__Plugin self;
369  SV *callback;
370
371  if (PL_dirty)
372   return;
373
374  rx = rxREGEXP(RX);
375  SELF_FROM_PPRIVATE(self, rx->pprivate);
376
377  callback = self->cb_free;
378
379  if (callback) {
380   dSP;
381
382   ENTER;
383   SAVETMPS;
384
385   PUSHMARK(SP);
386   XPUSHs(rx->pprivate);
387   PUTBACK;
388
389   call_sv(callback, G_DISCARD);
390
391   PUTBACK;
392   FREETMPS;
393   LEAVE;
394  }
395
396  SvREFCNT_dec(self->pattern);
397  SvREFCNT_dec(self->str);
398  SvREFCNT_dec(self->stash);
399
400  SvREFCNT_dec(self->cb_exec);
401
402  SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
403  SvREFCNT_dec(self->cb_num_capture_buff_STORE);
404  SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
405
406  self->rx = NULL;
407
408  Safefree(self);
409
410  SvREFCNT_dec(rx->pprivate);
411
412  return;
413 }
414
415 void *
416 Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param)
417 {
418  struct regexp *rx = rxREGEXP(RX);
419
420  Perl_croak(aTHX_ "dupe not supported yet");
421
422  return rx->pprivate;
423 }
424
425
426 void
427 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
428                            SV * const sv)
429 {
430  struct regexp     *rx;
431  re__engine__Plugin self;
432  SV *callback;
433
434  rx = rxREGEXP(RX);
435  SELF_FROM_PPRIVATE(self, rx->pprivate);
436
437  callback = self->cb_num_capture_buff_FETCH;
438
439  if (callback) {
440   I32 items;
441   dSP;
442
443   ENTER;
444   SAVETMPS;
445
446   PUSHMARK(SP);
447   XPUSHs(rx->pprivate);
448   mXPUSHi(paren);
449   PUTBACK;
450
451   items = call_sv(callback, G_SCALAR);
452
453   if (items == 1) {
454    SV *ret;
455    SPAGAIN;
456    ret = POPs;
457    sv_setsv(sv, ret);
458   } else {
459    sv_setsv(sv, &PL_sv_undef);
460   }
461
462   PUTBACK;
463   FREETMPS;
464   LEAVE;
465  } else {
466   sv_setsv(sv, &PL_sv_undef);
467  }
468 }
469
470 void
471 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
472                            SV const * const value)
473 {
474  struct regexp     *rx;
475  re__engine__Plugin self;
476  SV *callback;
477
478  rx = rxREGEXP(RX);
479  SELF_FROM_PPRIVATE(self, rx->pprivate);
480
481  callback = self->cb_num_capture_buff_STORE;
482
483  if (callback) {
484   dSP;
485
486   ENTER;
487   SAVETMPS;
488
489   PUSHMARK(SP);
490   XPUSHs(rx->pprivate);
491   mXPUSHi(paren);
492   XPUSHs((SV *) value);
493   PUTBACK;
494
495   call_sv(callback, G_DISCARD);
496
497   PUTBACK;
498   FREETMPS;
499   LEAVE;
500  }
501 }
502
503 I32
504 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
505                             const I32 paren)
506 {
507  struct regexp     *rx;
508  re__engine__Plugin self;
509  SV *callback;
510
511  rx = rxREGEXP(RX);
512  SELF_FROM_PPRIVATE(self, rx->pprivate);
513
514  callback = self->cb_num_capture_buff_LENGTH;
515
516  if (callback) {
517   IV ret;
518   dSP;
519
520   ENTER;
521   SAVETMPS;
522
523   PUSHMARK(SP);
524   XPUSHs(rx->pprivate);
525   mXPUSHi(paren);
526   PUTBACK;
527
528   call_sv(callback, G_SCALAR);
529
530   SPAGAIN;
531
532   ret = POPi;
533
534   PUTBACK;
535   FREETMPS;
536   LEAVE;
537
538   return (I32) ret;
539  } else {
540   /* TODO: call FETCH and get the length on that value */
541   return 0;
542  }
543 }
544
545 SV *
546 Plugin_named_buff(pTHX_ REGEXP * const RX, SV * const key, SV * const value,
547                   const U32 flags)
548 {
549  return NULL;
550 }
551
552 SV *
553 Plugin_named_buff_iter(pTHX_ REGEXP * const RX, const SV * const lastkey,
554                        const U32 flags)
555 {
556  return NULL;
557 }
558
559 SV *
560 Plugin_package(pTHX_ REGEXP * const RX)
561 {
562  PERL_UNUSED_ARG(RX);
563
564  return newSVpvs(XSH_PACKAGE);
565 }
566
567 static void xsh_user_global_setup(pTHX) {
568  HV *stash;
569
570  stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1);
571  newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(XSH_THREADSAFE));
572  newCONSTSUB(stash, "REP_FORKSAFE",   newSVuv(XSH_FORKSAFE));
573
574  return;
575 }
576
577 /* --- XS ------------------------------------------------------------------ */
578
579 MODULE = re::engine::Plugin       PACKAGE = re::engine::Plugin
580
581 PROTOTYPES: DISABLE
582
583 BOOT:
584 {
585  xsh_setup();
586 }
587
588 #if XSH_THREADSAFE
589
590 void
591 CLONE(...)
592 PPCODE:
593  xsh_clone();
594  XSRETURN(0);
595
596 #endif /* XSH_THREADSAFE */
597
598 void
599 pattern(re::engine::Plugin self, ...)
600 PPCODE:
601  XPUSHs(self->pattern);
602  XSRETURN(1);
603
604 void
605 str(re::engine::Plugin self, ...)
606 PPCODE:
607  XPUSHs(self->str);
608  XSRETURN(1);
609
610 void
611 mod(re::engine::Plugin self)
612 PREINIT:
613  U32 flags;
614  char mods[5 + 1];
615  int n = 0, i;
616 PPCODE:
617  flags = self->rx->intflags;
618  if (flags & PMf_FOLD)         /* /i */
619   mods[n++] = 'i';
620  if (flags & PMf_MULTILINE)    /* /m */
621   mods[n++] = 'm';
622  if (flags & PMf_SINGLELINE)   /* /s */
623   mods[n++] = 's';
624  if (flags & PMf_EXTENDED)     /* /x */
625   mods[n++] = 'x';
626  if (flags & RXf_PMf_KEEPCOPY) /* /p */
627   mods[n++] = 'p';
628  mods[n] = '\0';
629  EXTEND(SP, 2 * n);
630  for (i = 0; i < n; ++i) {
631   mPUSHp(mods + i, 1);
632   PUSHs(&PL_sv_yes);
633  }
634  XSRETURN(2 * n);
635
636 void
637 stash(re::engine::Plugin self, ...)
638 PPCODE:
639  if (items > 1) {
640   SvREFCNT_dec(self->stash);
641   self->stash = ST(1);
642   SvREFCNT_inc_simple_void(self->stash);
643   XSRETURN_EMPTY;
644  } else {
645   XPUSHs(self->stash);
646   XSRETURN(1);
647  }
648
649 void
650 minlen(re::engine::Plugin self, ...)
651 PPCODE:
652  if (items > 1) {
653   self->rx->minlen = (I32)SvIV(ST(1));
654   XSRETURN_EMPTY;
655  } else if (self->rx->minlen) {
656   mXPUSHi(self->rx->minlen);
657   XSRETURN(1);
658  } else {
659   XSRETURN_UNDEF;
660  }
661
662 void
663 gofs(re::engine::Plugin self, ...)
664 PPCODE:
665  if (items > 1) {
666   self->rx->gofs = (U32)SvIV(ST(1));
667   XSRETURN_EMPTY;
668  } else if (self->rx->gofs) {
669   mXPUSHu(self->rx->gofs);
670   XSRETURN(1);
671  } else {
672   XSRETURN_UNDEF;
673  }
674
675 void
676 nparens(re::engine::Plugin self, ...)
677 PPCODE:
678  if (items > 1) {
679   self->rx->nparens = (U32)SvIV(ST(1));
680   XSRETURN_EMPTY;
681  } else if (self->rx->nparens) {
682   mXPUSHu(self->rx->nparens);
683   XSRETURN(1);
684  } else {
685   XSRETURN_UNDEF;
686  }
687
688 void
689 _exec(re::engine::Plugin self, ...)
690 PPCODE:
691  if (items > 1) {
692   SvREFCNT_dec(self->cb_exec);
693   self->cb_exec = ST(1);
694   SvREFCNT_inc_simple_void(self->cb_exec);
695  }
696  XSRETURN(0);
697
698 void
699 _free(re::engine::Plugin self, ...)
700 PPCODE:
701  if (items > 1) {
702   SvREFCNT_dec(self->cb_free);
703   self->cb_free = ST(1);
704   SvREFCNT_inc_simple_void(self->cb_free);
705  }
706  XSRETURN(0);
707
708 void
709 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
710 PPCODE:
711  if (items > 1) {
712   SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
713   self->cb_num_capture_buff_FETCH = ST(1);
714   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH);
715  }
716  XSRETURN(0);
717
718 void
719 _num_capture_buff_STORE(re::engine::Plugin self, ...)
720 PPCODE:
721  if (items > 1) {
722   SvREFCNT_dec(self->cb_num_capture_buff_STORE);
723   self->cb_num_capture_buff_STORE = ST(1);
724   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE);
725  }
726  XSRETURN(0);
727
728 void
729 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
730 PPCODE:
731  if (items > 1) {
732   SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
733   self->cb_num_capture_buff_LENGTH = ST(1);
734   SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH);
735  }
736  XSRETURN(0);
737
738 SV *
739 _tag(SV *comp, SV *exec, SV *free)
740 PREINIT:
741  xsh_hints_user_t arg;
742 CODE:
743  arg.comp = comp;
744  arg.exec = exec;
745  arg.free = free;
746  RETVAL = xsh_hints_tag(&arg);
747 OUTPUT:
748  RETVAL
749
750 void
751 ENGINE()
752 PPCODE:
753  mXPUSHi(PTR2IV(&engine_plugin));
754  XSRETURN(1);