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 #include "Plugin.h"
  10
  11 #define __PACKAGE__     "re::engine::Plugin"
  12 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  13
  14 #ifndef ENTER_with_name
  15 # define ENTER_with_name(N) ENTER
  16 #endif
  17
  18 #ifndef LEAVE_with_name
  19 # define LEAVE_with_name(N) LEAVE
  20 #endif
  21
  22 #define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
  23
  24 #ifndef REP_WORKAROUND_REQUIRE_PROPAGATION
  25 # define REP_WORKAROUND_REQUIRE_PROPAGATION !REP_HAS_PERL(5, 10, 1)
  26 #endif
  27
  28 /* ... Thread safety and multiplicity ...................................... */
  29
  30 #ifndef REP_MULTIPLICITY
  31 # if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
  32 #  define REP_MULTIPLICITY 1
  33 # else
  34 #  define REP_MULTIPLICITY 0
  35 # endif
  36 #endif
  37 #if REP_MULTIPLICITY && !defined(tTHX)
  38 # define tTHX PerlInterpreter*
  39 #endif
  40
  41 #if REP_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV))
  42 # define REP_THREADSAFE 1
  43 # ifndef MY_CXT_CLONE
  44 #  define MY_CXT_CLONE \
  45     dMY_CXT_SV;                                                      \
  46     my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
  47     Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
  48     sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
  49 # endif
  50 #else
  51 # define REP_THREADSAFE 0
  52 # undef  dMY_CXT
  53 # define dMY_CXT      dNOOP
  54 # undef  MY_CXT
  55 # define MY_CXT       rep_globaldata
  56 # undef  START_MY_CXT
  57 # define START_MY_CXT STATIC my_cxt_t MY_CXT;
  58 # undef  MY_CXT_INIT
  59 # define MY_CXT_INIT  NOOP
  60 # undef  MY_CXT_CLONE
  61 # define MY_CXT_CLONE NOOP
  62 #endif
  63
  64 /* --- Helpers ------------------------------------------------------------- */
  65
  66 /* ... Thread-safe hints ................................................... */
  67
  68 typedef struct {
  69  SV *comp;
  70  SV *exec;
  71 #if REP_WORKAROUND_REQUIRE_PROPAGATION
  72  IV  cxreq;
  73 #endif
  74 } rep_hint_t;
  75
  76 #if REP_THREADSAFE
  77
  78 #define PTABLE_VAL_FREE(V) { \
  79  rep_hint_t *h = (V);        \
  80  SvREFCNT_dec(h->comp);      \
  81  SvREFCNT_dec(h->exec);      \
  82  PerlMemShared_free(h);      \
  83 }
  84
  85 #define pPTBL  pTHX
  86 #define pPTBL_ pTHX_
  87 #define aPTBL  aTHX
  88 #define aPTBL_ aTHX_
  89
  90 #include "ptable.h"
  91
  92 #define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
  93 #define ptable_free(T)        ptable_free(aTHX_ (T))
  94
  95 #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
  96
  97 typedef struct {
  98  ptable *tbl;
  99  tTHX    owner;
 100 } my_cxt_t;
 101
 102 START_MY_CXT
 103
 104 STATIC SV *rep_clone(pTHX_ SV *sv, tTHX owner) {
 105 #define rep_clone(S, O) rep_clone(aTHX_ (S), (O))
 106  CLONE_PARAMS  param;
 107  AV           *stashes = NULL;
 108  SV           *dupsv;
 109
 110  if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv))
 111   stashes = newAV();
 112
 113  param.stashes    = stashes;
 114  param.flags      = 0;
 115  param.proto_perl = owner;
 116
 117  dupsv = sv_dup(sv, &param);
 118
 119  if (stashes) {
 120   av_undef(stashes);
 121   SvREFCNT_dec(stashes);
 122  }
 123
 124  return SvREFCNT_inc(dupsv);
 125 }
 126
 127 STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
 128  my_cxt_t   *ud = ud_;
 129  rep_hint_t *h1 = ent->val;
 130  rep_hint_t *h2;
 131
 132  if (ud->owner == aTHX)
 133   return;
 134
 135  h2        = PerlMemShared_malloc(sizeof *h2);
 136  h2->comp  = rep_clone(h1->comp, ud->owner);
 137  SvREFCNT_inc(h2->comp);
 138  h2->exec  = rep_clone(h1->exec, ud->owner);
 139  SvREFCNT_inc(h2->exec);
 140 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 141  h2->cxreq = h1->cxreq;
 142 #endif
 143
 144  ptable_store(ud->tbl, ent->key, h2);
 145 }
 146
 147 STATIC void rep_thread_cleanup(pTHX_ void *);
 148
 149 STATIC void rep_thread_cleanup(pTHX_ void *ud) {
 150  int *level = ud;
 151
 152  if (*level) {
 153   *level = 0;
 154   LEAVE;
 155   SAVEDESTRUCTOR_X(rep_thread_cleanup, level);
 156   ENTER;
 157  } else {
 158   dMY_CXT;
 159   PerlMemShared_free(level);
 160   ptable_free(MY_CXT.tbl);
 161  }
 162 }
 163
 164 #endif /* REP_THREADSAFE */
 165
 166 STATIC SV *rep_validate_callback(SV *code) {
 167  if (!SvROK(code))
 168   return NULL;
 169
 170  code = SvRV(code);
 171  if (SvTYPE(code) < SVt_PVCV)
 172   return NULL;
 173
 174  return SvREFCNT_inc_simple_NN(code);
 175 }
 176
 177 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 178 STATIC IV rep_require_tag(pTHX) {
 179 #define rep_require_tag() rep_require_tag(aTHX)
 180  const PERL_SI *si;
 181
 182  for (si = PL_curstackinfo; si; si = si->si_prev) {
 183   I32 cxix;
 184
 185   for (cxix = si->si_cxix; cxix >= 0; --cxix) {
 186    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 187
 188    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
 189     return PTR2IV(cx);
 190   }
 191  }
 192
 193  return PTR2IV(NULL);
 194 }
 195 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 196
 197 STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) {
 198 #define rep_tag(C, E) rep_tag(aTHX_ (C), (E))
 199  rep_hint_t *h;
 200  dMY_CXT;
 201
 202  h = PerlMemShared_malloc(sizeof *h);
 203  h->comp  = rep_validate_callback(comp);
 204  h->exec  = rep_validate_callback(exec);
 205 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 206  h->cxreq = rep_require_tag();
 207 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 208
 209 #if REP_THREADSAFE
 210  /* We only need for the key to be an unique tag for looking up the value later.
 211   * Allocated memory provides convenient unique identifiers, so that's why we
 212   * use the hint as the key itself. */
 213  ptable_store(MY_CXT.tbl, h, h);
 214 #endif /* REP_THREADSAFE */
 215
 216  return newSViv(PTR2IV(h));
 217 }
 218
 219 STATIC const rep_hint_t *rep_detag(pTHX_ const SV *hint) {
 220 #define rep_detag(H) rep_detag(aTHX_ (H))
 221  rep_hint_t *h;
 222  dMY_CXT;
 223
 224  if (!(hint && SvIOK(hint)))
 225   return NULL;
 226
 227  h = INT2PTR(rep_hint_t *, SvIVX(hint));
 228 #if REP_THREADSAFE
 229  h = ptable_fetch(MY_CXT.tbl, h);
 230 #endif /* REP_THREADSAFE */
 231
 232 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 233  if (rep_require_tag() != h->cxreq)
 234   return NULL;
 235 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 236
 237  return h;
 238 }
 239
 240 STATIC U32 rep_hash = 0;
 241
 242 STATIC const rep_hint_t *rep_hint(pTHX) {
 243 #define rep_hint() rep_hint(aTHX)
 244  SV *hint;
 245
 246  /* We already require 5.9.5 for the regexp engine API. */
 247  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
 248                                        NULL,
 249                                        __PACKAGE__, __PACKAGE_LEN__,
 250                                        0,
 251                                        rep_hash);
 252
 253  return rep_detag(hint);
 254 }
 255
 256 REGEXP *
 257 #if PERL_VERSION <= 10
 258 Plugin_comp(pTHX_ const SV * const pattern, const U32 flags)
 259 #else
 260 Plugin_comp(pTHX_ SV * const pattern, U32 flags)
 261 #endif
 262 {
 263     dSP;
 264     struct regexp * rx;
 265     REGEXP *RX;
 266     I32 buffers;
 267     re__engine__Plugin re;
 268     const rep_hint_t *h;
 269
 270     h = rep_hint();
 271     if (!h) /* This looks like a pragma leak. Apply the default behaviour */
 272         return re_compile(pattern, flags);
 273
 274     /* exp/xend version of the pattern & length */
 275     STRLEN plen;
 276     char*  exp = SvPV((SV*)pattern, plen);
 277
 278     /* Our blessed object */
 279     SV *obj = newSV(0);
 280     SvREFCNT_inc(obj);
 281     Newxz(re, 1, struct replug);
 282     sv_setref_pv(obj, "re::engine::Plugin", (void*)re);
 283
 284     newREGEXP(RX);
 285     rx = rxREGEXP(RX);
 286
 287     re->rx = rx;                   /* Make the rx accessible from self->rx */
 288     rx->intflags = flags;          /* Flags for internal use */
 289     rx->extflags = flags;          /* Flags for perl to use */
 290     rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */
 291
 292 #if PERL_VERSION <= 10
 293     rx->refcnt = 1;                /* Refcount so we won't be destroyed */
 294
 295     /* Precompiled pattern for pp_regcomp to use */
 296     rx->prelen = plen;
 297     rx->precomp = savepvn(exp, rx->prelen);
 298
 299     /* Set up qr// stringification to be equivalent to the supplied
 300      * pattern, this should be done via overload eventually.
 301      */
 302     rx->wraplen = rx->prelen;
 303     Newx(rx->wrapped, rx->wraplen, char);
 304     Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
 305 #endif
 306
 307     /* Store our private object */
 308     rx->pprivate = obj;
 309
 310     /* Store the pattern for ->pattern */
 311     re->pattern = (SV*)pattern;
 312     SvREFCNT_inc(re->pattern);
 313
 314     /* If there's an exec callback, store it into the private object so
 315      * that it will be the one to be called, even if the engine changes
 316      * in between */
 317     if (h->exec) {
 318         re->cb_exec = h->exec;
 319         SvREFCNT_inc_simple_void_NN(h->exec);
 320     }
 321
 322     re->cb_num_capture_buff_FETCH  = NULL;
 323     re->cb_num_capture_buff_STORE  = NULL;
 324     re->cb_num_capture_buff_LENGTH = NULL;
 325
 326     /* Call our callback function if one was defined, if not we've
 327      * already set up all the stuff we're going to to need for
 328      * subsequent exec and other calls */
 329     if (h->comp) {
 330         ENTER;
 331         SAVETMPS;
 332
 333         PUSHMARK(SP);
 334         XPUSHs(obj);
 335         PUTBACK;
 336
 337         call_sv(h->comp, G_DISCARD);
 338
 339         FREETMPS;
 340         LEAVE;
 341     }
 342
 343     /* If any of the comp-time accessors were called we'll have to
 344      * update the regexp struct with the new info.
 345      */
 346
 347     buffers = rx->nparens;
 348
 349     Newxz(rx->offs, buffers + 1, regexp_paren_pair);
 350
 351     return RX;
 352 }
 353
 354 I32
 355 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
 356             char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 357 {
 358     dSP;
 359     I32 matched;
 360     struct regexp *rx = rxREGEXP(RX);
 361     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 362
 363     if (self->cb_exec) {
 364         /* Store the current str for ->str */
 365         self->str = (SV*)sv;
 366         SvREFCNT_inc(self->str);
 367
 368         ENTER;
 369         SAVETMPS;
 370
 371         PUSHMARK(SP);
 372         XPUSHs(rx->pprivate);
 373         XPUSHs(sv);
 374         PUTBACK;
 375
 376         call_sv(self->cb_exec, G_SCALAR);
 377
 378         SPAGAIN;
 379
 380         SV * ret = POPs;
 381
 382         if (SvTRUE(ret))
 383             matched = 1;
 384         else
 385             matched = 0;
 386
 387         PUTBACK;
 388         FREETMPS;
 389         LEAVE;
 390     } else {
 391         matched = 0;
 392     }
 393
 394     return matched;
 395 }
 396
 397 char *
 398 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos,
 399                      char *strend, U32 flags, re_scream_pos_data *data)
 400 {
 401     PERL_UNUSED_ARG(RX);
 402     PERL_UNUSED_ARG(sv);
 403     PERL_UNUSED_ARG(strpos);
 404     PERL_UNUSED_ARG(strend);
 405     PERL_UNUSED_ARG(flags);
 406     PERL_UNUSED_ARG(data);
 407     return NULL;
 408 }
 409
 410 SV *
 411 Plugin_checkstr(pTHX_ REGEXP * const RX)
 412 {
 413     PERL_UNUSED_ARG(RX);
 414     return NULL;
 415 }
 416
 417 void
 418 Plugin_free(pTHX_ REGEXP * const RX)
 419 {
 420     struct regexp *rx = rxREGEXP(RX);
 421     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 422
 423     SvREFCNT_dec(self->pattern);
 424     SvREFCNT_dec(self->str);
 425
 426     SvREFCNT_dec(self->cb_exec);
 427
 428     SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
 429     SvREFCNT_dec(self->cb_num_capture_buff_STORE);
 430     SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
 431
 432     self->rx = NULL;
 433     Safefree(self);
 434
 435 /*
 436     dSP;
 437     SV * callback;
 438
 439     callback = self->cb_free;
 440
 441     if (callback) {
 442         ENTER;
 443         SAVETMPS;
 444
 445         PUSHMARK(SP);
 446         XPUSHs(rx->pprivate);
 447         PUTBACK;
 448
 449         call_sv(callback, G_DISCARD);
 450
 451         PUTBACK;
 452         FREETMPS;
 453         LEAVE;
 454     }
 455     return;
 456 */
 457 }
 458
 459 void *
 460 Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param)
 461 {
 462     struct regexp *rx = rxREGEXP(RX);
 463     Perl_croak(aTHX_ "dupe not supported yet");
 464     return rx->pprivate;
 465 }
 466
 467
 468 void
 469 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
 470                            SV * const sv)
 471 {
 472     dSP;
 473     I32 items;
 474     SV * callback;
 475     struct regexp *rx = rxREGEXP(RX);
 476     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 477
 478     callback = self->cb_num_capture_buff_FETCH;
 479
 480     if (callback) {
 481         ENTER;
 482         SAVETMPS;
 483
 484         PUSHMARK(SP);
 485         XPUSHs(rx->pprivate);
 486         XPUSHs(sv_2mortal(newSViv(paren)));
 487         PUTBACK;
 488
 489         items = call_sv(callback, G_SCALAR);
 490
 491         if (items == 1) {
 492             SPAGAIN;
 493
 494             SV * ret = POPs;
 495             sv_setsv(sv, ret);
 496         } else {
 497             sv_setsv(sv, &PL_sv_undef);
 498         }
 499
 500         PUTBACK;
 501         FREETMPS;
 502         LEAVE;
 503     } else {
 504         sv_setsv(sv, &PL_sv_undef);
 505     }
 506 }
 507
 508 void
 509 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
 510                            SV const * const value)
 511 {
 512     dSP;
 513     SV * callback;
 514     struct regexp *rx = rxREGEXP(RX);
 515     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 516
 517     callback = self->cb_num_capture_buff_STORE;
 518
 519     if (callback) {
 520         ENTER;
 521         SAVETMPS;
 522
 523         PUSHMARK(SP);
 524         XPUSHs(rx->pprivate);
 525         XPUSHs(sv_2mortal(newSViv(paren)));
 526         XPUSHs(SvREFCNT_inc((SV *) value));
 527         PUTBACK;
 528
 529         call_sv(callback, G_DISCARD);
 530
 531         PUTBACK;
 532         FREETMPS;
 533         LEAVE;
 534     }
 535 }
 536
 537 I32
 538 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
 539                               const I32 paren)
 540 {
 541     dSP;
 542     SV * callback;
 543     struct regexp *rx = rxREGEXP(RX);
 544     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 545
 546     callback = self->cb_num_capture_buff_LENGTH;
 547
 548     if (callback) {
 549         ENTER;
 550         SAVETMPS;
 551
 552         PUSHMARK(SP);
 553         XPUSHs(rx->pprivate);
 554         XPUSHs(sv_2mortal(newSViv(paren)));
 555         PUTBACK;
 556
 557         call_sv(callback, G_SCALAR);
 558
 559         SPAGAIN;
 560
 561         IV ret = POPi;
 562
 563         PUTBACK;
 564         FREETMPS;
 565         LEAVE;
 566
 567         return (I32)ret;
 568     } else {
 569         /* TODO: call FETCH and get the length on that value */
 570         return 0;
 571     }
 572 }
 573
 574
 575 SV*
 576 Plugin_named_buff (pTHX_ REGEXP * const RX, SV * const key, SV * const value,
 577                    const U32 flags)
 578 {
 579     return NULL;
 580 }
 581
 582 SV*
 583 Plugin_named_buff_iter (pTHX_ REGEXP * const RX, const SV * const lastkey,
 584                         const U32 flags)
 585 {
 586     return NULL;
 587 }
 588
 589 SV*
 590 Plugin_package(pTHX_ REGEXP * const RX)
 591 {
 592     PERL_UNUSED_ARG(RX);
 593     return newSVpvs("re::engine::Plugin");
 594 }
 595
 596 #if REP_THREADSAFE
 597
 598 STATIC U32 rep_initialized = 0;
 599
 600 STATIC void rep_teardown(pTHX_ void *root) {
 601  dMY_CXT;
 602
 603  if (!rep_initialized || aTHX != root)
 604   return;
 605
 606  ptable_free(MY_CXT.tbl);
 607
 608  rep_initialized = 0;
 609 }
 610
 611 STATIC void rep_setup(pTHX) {
 612 #define rep_setup() rep_setup(aTHX)
 613  if (rep_initialized)
 614   return;
 615
 616  MY_CXT_INIT;
 617  MY_CXT.tbl   = ptable_new();
 618  MY_CXT.owner = aTHX;
 619
 620  call_atexit(rep_teardown, aTHX);
 621
 622  rep_initialized = 1;
 623 }
 624
 625 #else  /*  REP_THREADSAFE */
 626
 627 #define rep_setup()
 628
 629 #endif /* !REP_THREADSAFE */
 630
 631 STATIC U32 rep_booted = 0;
 632
 633 /* --- XS ------------------------------------------------------------------ */
 634
 635 MODULE = re::engine::Plugin     PACKAGE = re::engine::Plugin
 636
 637 PROTOTYPES: DISABLE
 638
 639 BOOT:
 640 {
 641     if (!rep_booted++) {
 642         PERL_HASH(rep_hash, __PACKAGE__, __PACKAGE_LEN__);
 643     }
 644
 645     rep_setup();
 646 }
 647
 648 #if REP_THREADSAFE
 649
 650 void
 651 CLONE(...)
 652 PREINIT:
 653     ptable *t;
 654     int    *level;
 655 CODE:
 656     {
 657         my_cxt_t ud;
 658         dMY_CXT;
 659         ud.tbl   = t = ptable_new();
 660         ud.owner = MY_CXT.owner;
 661         ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
 662     }
 663     {
 664         MY_CXT_CLONE;
 665         MY_CXT.tbl   = t;
 666         MY_CXT.owner = aTHX;
 667     }
 668     {
 669         level = PerlMemShared_malloc(sizeof *level);
 670         *level = 1;
 671         LEAVE_with_name("sub");
 672         SAVEDESTRUCTOR_X(rep_thread_cleanup, level);
 673         ENTER_with_name("sub");
 674     }
 675
 676 #endif
 677
 678 void
 679 pattern(re::engine::Plugin self, ...)
 680 PPCODE:
 681     XPUSHs(self->pattern);
 682
 683 void
 684 str(re::engine::Plugin self, ...)
 685 PPCODE:
 686     XPUSHs(self->str);
 687
 688 char*
 689 mod(re::engine::Plugin self, ...)
 690 PPCODE:
 691     /* /i */
 692     if (self->rx->intflags & PMf_FOLD) {
 693       XPUSHs(sv_2mortal(newSVpvs("i")));
 694       XPUSHs(&PL_sv_yes);
 695     }
 696
 697     /* /m */
 698     if (self->rx->intflags & PMf_MULTILINE) {
 699       XPUSHs(sv_2mortal(newSVpvs("m")));
 700       XPUSHs(&PL_sv_yes);
 701     }
 702
 703     /* /s */
 704     if (self->rx->intflags & PMf_SINGLELINE) {
 705       XPUSHs(sv_2mortal(newSVpvs("s")));
 706       XPUSHs(&PL_sv_yes);
 707     }
 708
 709     /* /x */
 710     if (self->rx->intflags & PMf_EXTENDED) {
 711       XPUSHs(sv_2mortal(newSVpvs("x")));
 712       XPUSHs(&PL_sv_yes);
 713     }
 714
 715     /* /p */
 716     if (self->rx->intflags & RXf_PMf_KEEPCOPY) {
 717       XPUSHs(sv_2mortal(newSVpvs("p")));
 718       XPUSHs(&PL_sv_yes);
 719     }
 720
 721 void
 722 stash(re::engine::Plugin self, ...)
 723 PPCODE:
 724     if (items > 1) {
 725         self->stash = ST(1);
 726         SvREFCNT_inc(self->stash);
 727         XSRETURN_EMPTY;
 728     } else {
 729         XPUSHs(self->stash);
 730     }
 731
 732 void
 733 minlen(re::engine::Plugin self, ...)
 734 PPCODE:
 735     if (items > 1) {
 736         self->rx->minlen = (I32)SvIV(ST(1));
 737         XSRETURN_EMPTY;
 738     } else {
 739         if (self->rx->minlen) {
 740             XPUSHs(sv_2mortal(newSViv(self->rx->minlen)));
 741         } else {
 742             XPUSHs(sv_2mortal(&PL_sv_undef));
 743         }
 744     }
 745
 746 void
 747 gofs(re::engine::Plugin self, ...)
 748 PPCODE:
 749     if (items > 1) {
 750         self->rx->gofs = (U32)SvIV(ST(1));
 751         XSRETURN_EMPTY;
 752     } else {
 753         if (self->rx->gofs) {
 754             XPUSHs(sv_2mortal(newSVuv(self->rx->gofs)));
 755         } else {
 756             XPUSHs(sv_2mortal(&PL_sv_undef));
 757         }
 758     }
 759
 760 void
 761 nparens(re::engine::Plugin self, ...)
 762 PPCODE:
 763     if (items > 1) {
 764         self->rx->nparens = (U32)SvIV(ST(1));
 765         XSRETURN_EMPTY;
 766     } else {
 767         if (self->rx->nparens) {
 768             XPUSHs(sv_2mortal(newSVuv(self->rx->nparens)));
 769         } else {
 770             XPUSHs(sv_2mortal(&PL_sv_undef));
 771         }
 772     }
 773
 774 void
 775 _exec(re::engine::Plugin self, ...)
 776 PPCODE:
 777     if (items > 1) {
 778         SvREFCNT_dec(self->cb_exec);
 779         self->cb_exec = ST(1);
 780         SvREFCNT_inc(self->cb_exec);
 781     }
 782
 783 void
 784 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 785 PPCODE:
 786     if (items > 1) {
 787         SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
 788         self->cb_num_capture_buff_FETCH = ST(1);
 789         SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
 790     }
 791
 792 void
 793 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 794 PPCODE:
 795     if (items > 1) {
 796         SvREFCNT_dec(self->cb_num_capture_buff_STORE);
 797         self->cb_num_capture_buff_STORE = ST(1);
 798         SvREFCNT_inc(self->cb_num_capture_buff_STORE);
 799     }
 800
 801 void
 802 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 803 PPCODE:
 804     if (items > 1) {
 805         SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
 806         self->cb_num_capture_buff_LENGTH = ST(1);
 807         SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
 808     }
 809
 810 SV *
 811 _tag(SV *comp, SV *exec)
 812 CODE:
 813     RETVAL = rep_tag(comp, exec);
 814 OUTPUT:
 815     RETVAL
 816
 817 void
 818 ENGINE()
 819 PPCODE:
 820     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));