Plugin.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4 #include "Plugin.h"
   5
   6 SV*
   7 get_H_callback(const char* key)
   8 {
   9     dVAR;
  10     dSP;
  11
  12     SV * callback;
  13
  14     ENTER;
  15     SAVETMPS;
  16
  17     PUSHMARK(SP);
  18     XPUSHs(sv_2mortal(newSVpv(key, 0)));
  19     PUTBACK;
  20
  21     call_pv("re::engine::Plugin::_get_callback", G_SCALAR);
  22
  23     SPAGAIN;
  24
  25     callback = POPs;
  26     SvREFCNT_inc(callback); /* refcount++ or FREETMPS below will collect us */
  27
  28     /* If we don't get a valid CODE value return a NULL callback, in
  29      * that case the hooks won't call back into Perl space */
  30     if (!SvROK(callback) || SvTYPE(SvRV(callback)) != SVt_PVCV) {
  31         callback = NULL;
  32     }
  33
  34     PUTBACK;
  35     FREETMPS;
  36     LEAVE;
  37
  38     return callback;
  39 }
  40
  41 REGEXP *
  42 Plugin_comp(pTHX_ const SV * const pattern, const U32 flags)
  43 {
  44     dSP;
  45     REGEXP * rx;
  46     re__engine__Plugin re;
  47     I32 buffers;
  48
  49     /* exp/xend version of the pattern & length */
  50     STRLEN plen;
  51     char*  exp = SvPV((SV*)pattern, plen);
  52
  53     /* The REGEXP structure to return to perl */
  54     Newxz(rx, 1, REGEXP);
  55
  56     /* Our blessed object */
  57     SV *obj = newSV(0);
  58     SvREFCNT_inc(obj);
  59     Newxz(re, 1, struct replug);
  60     sv_setref_pv(obj, "re::engine::Plugin", (void*)re);
  61
  62     re->rx = rx;                   /* Make the rx accessible from self->rx */
  63     rx->refcnt = 1;                /* Refcount so we won' be destroyed */
  64     rx->intflags = flags;          /* Flags for internal use */
  65     rx->extflags = flags;          /* Flags for perl to use */
  66     rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */
  67
  68     /* Precompiled pattern for pp_regcomp to use */
  69     rx->prelen = plen;
  70     rx->precomp = savepvn(exp, rx->prelen);
  71
  72     /* Set up qr// stringification to be equivalent to the supplied
  73      * pattern, this should be done via overload eventually.
  74      */
  75     rx->wraplen = rx->prelen;
  76     Newx(rx->wrapped, rx->wraplen, char);
  77     Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
  78
  79     /* Store our private object */
  80     rx->pprivate = obj;
  81
  82     /* Store the pattern for ->pattern */
  83     re->pattern = (SV*)pattern;
  84     SvREFCNT_inc(re->pattern);
  85
  86     /*
  87      * Call our callback function if one was defined, if not we've
  88      * already set up all the stuff we're going to to need for
  89      * subsequent exec and other calls
  90      */
  91     SV * callback = get_H_callback("comp");
  92
  93     if (callback) {
  94         ENTER;
  95         SAVETMPS;
  96
  97         PUSHMARK(SP);
  98         XPUSHs(obj);
  99         PUTBACK;
 100
 101         call_sv(callback, G_DISCARD);
 102
 103         FREETMPS;
 104         LEAVE;
 105     }
 106
 107     /* If any of the comp-time accessors were called we'll have to
 108      * update the regexp struct with the new info.
 109      */
 110
 111     buffers = rx->nparens;
 112
 113     Newxz(rx->offs, buffers + 1, regexp_paren_pair);
 114
 115     return rx;
 116 }
 117
 118 I32
 119 Plugin_exec(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
 120             char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 121 {
 122     dSP;
 123     I32 matched;
 124     SV * callback = get_H_callback("exec");
 125     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 126
 127     if (callback) {
 128         /* Store the current str for ->str */
 129         self->str = (SV*)sv;
 130         SvREFCNT_inc(self->str);
 131
 132         ENTER;
 133         SAVETMPS;
 134
 135         PUSHMARK(SP);
 136         XPUSHs(rx->pprivate);
 137         XPUSHs(sv);
 138         PUTBACK;
 139
 140         call_sv(callback, G_SCALAR);
 141
 142         SPAGAIN;
 143
 144         SV * ret = POPs;
 145
 146         if (SvTRUE(ret))
 147             matched = 1;
 148         else
 149             matched = 0;
 150
 151         PUTBACK;
 152         FREETMPS;
 153         LEAVE;
 154     } else {
 155         matched = 0;
 156     }
 157
 158     return matched;
 159 }
 160
 161 char *
 162 Plugin_intuit(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 163                      char *strend, U32 flags, re_scream_pos_data *data)
 164 {
 165     PERL_UNUSED_ARG(rx);
 166     PERL_UNUSED_ARG(sv);
 167     PERL_UNUSED_ARG(strpos);
 168     PERL_UNUSED_ARG(strend);
 169     PERL_UNUSED_ARG(flags);
 170     PERL_UNUSED_ARG(data);
 171     return NULL;
 172 }
 173
 174 SV *
 175 Plugin_checkstr(pTHX_ REGEXP * const rx)
 176 {
 177     PERL_UNUSED_ARG(rx);
 178     return NULL;
 179 }
 180
 181 void
 182 Plugin_free(pTHX_ REGEXP * const rx)
 183 {
 184     PERL_UNUSED_ARG(rx);
 185 /*
 186     dSP;
 187     SV * callback;
 188     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 189
 190     callback = self->cb_free;
 191
 192     if (callback) {
 193         ENTER;
 194         SAVETMPS;
 195
 196         PUSHMARK(SP);
 197         XPUSHs(rx->pprivate);
 198         PUTBACK;
 199
 200         call_sv(callback, G_DISCARD);
 201
 202         PUTBACK;
 203         FREETMPS;
 204         LEAVE;
 205     }
 206     return;
 207 */
 208 }
 209
 210 void *
 211 Plugin_dupe(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
 212 {
 213     Perl_croak(aTHX_ "dupe not supported yet");
 214     return rx->pprivate;
 215 }
 216
 217
 218 void
 219 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const rx, const I32 paren,
 220                            SV * const sv)
 221 {
 222     dSP;
 223     I32 items;
 224     SV * callback;
 225     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 226
 227     callback = self->cb_num_capture_buff_FETCH;
 228
 229     if (callback) {
 230         ENTER;
 231         SAVETMPS;
 232
 233         PUSHMARK(SP);
 234         XPUSHs(rx->pprivate);
 235         XPUSHs(sv_2mortal(newSViv(paren)));
 236         PUTBACK;
 237
 238         items = call_sv(callback, G_SCALAR);
 239
 240         if (items == 1) {
 241             SPAGAIN;
 242
 243             SV * ret = POPs;
 244             sv_setsv(sv, ret);
 245         } else {
 246             sv_setsv(sv, &PL_sv_undef);
 247         }
 248
 249         PUTBACK;
 250         FREETMPS;
 251         LEAVE;
 252     } else {
 253         sv_setsv(sv, &PL_sv_undef);
 254     }
 255 }
 256
 257 void
 258 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const rx, const I32 paren,
 259                            SV const * const value)
 260 {
 261     dSP;
 262     SV * callback;
 263     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 264
 265     callback = self->cb_num_capture_buff_STORE;
 266
 267     if (callback) {
 268         ENTER;
 269         SAVETMPS;
 270
 271         PUSHMARK(SP);
 272         XPUSHs(rx->pprivate);
 273         XPUSHs(sv_2mortal(newSViv(paren)));
 274         XPUSHs(SvREFCNT_inc(value));
 275         PUTBACK;
 276
 277         call_sv(callback, G_DISCARD);
 278
 279         PUTBACK;
 280         FREETMPS;
 281         LEAVE;
 282     }
 283 }
 284
 285 I32
 286 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const rx, const SV * const sv,
 287                               const I32 paren)
 288 {
 289     dSP;
 290     SV * callback;
 291     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 292
 293     callback = self->cb_num_capture_buff_LENGTH;
 294
 295     if (callback) {
 296         ENTER;
 297         SAVETMPS;
 298
 299         PUSHMARK(SP);
 300         XPUSHs(rx->pprivate);
 301         XPUSHs(sv_2mortal(newSViv(paren)));
 302         PUTBACK;
 303
 304         call_sv(callback, G_SCALAR);
 305
 306         SPAGAIN;
 307
 308         IV ret = POPi;
 309
 310         PUTBACK;
 311         FREETMPS;
 312         LEAVE;
 313
 314         return (I32)ret;
 315     } else {
 316         /* TODO: call FETCH and get the length on that value */
 317         return 0;
 318     }
 319 }
 320
 321
 322 SV*
 323 Plugin_named_buff (pTHX_ REGEXP * const rx, SV * const key, SV * const value,
 324                    const U32 flags)
 325 {
 326     return NULL;
 327 }
 328
 329 SV*
 330 Plugin_named_buff_iter (pTHX_ REGEXP * const rx, const SV * const lastkey,
 331                         const U32 flags)
 332 {
 333     return NULL;
 334 }
 335
 336 SV*
 337 Plugin_package(pTHX_ REGEXP * const rx)
 338 {
 339     PERL_UNUSED_ARG(rx);
 340     return newSVpvs("re::engine::Plugin");
 341 }
 342
 343 MODULE = re::engine::Plugin     PACKAGE = re::engine::Plugin
 344 PROTOTYPES: DISABLE
 345
 346 void
 347 pattern(re::engine::Plugin self, ...)
 348 PPCODE:
 349     XPUSHs(self->pattern);
 350
 351 void
 352 str(re::engine::Plugin self, ...)
 353 PPCODE:
 354     XPUSHs(self->str);
 355
 356 char*
 357 mod(re::engine::Plugin self, ...)
 358 PPCODE:
 359     /* /i */
 360     if (self->rx->intflags & PMf_FOLD) {
 361       XPUSHs(sv_2mortal(newSVpvs("i")));
 362       XPUSHs(&PL_sv_yes);
 363     }
 364
 365     /* /m */
 366     if (self->rx->intflags & PMf_MULTILINE) {
 367       XPUSHs(sv_2mortal(newSVpvs("m")));
 368       XPUSHs(&PL_sv_yes);
 369     }
 370
 371     /* /s */
 372     if (self->rx->intflags & PMf_SINGLELINE) {
 373       XPUSHs(sv_2mortal(newSVpvs("s")));
 374       XPUSHs(&PL_sv_yes);
 375     }
 376
 377     /* /x */
 378     if (self->rx->intflags & PMf_EXTENDED) {
 379       XPUSHs(sv_2mortal(newSVpvs("x")));
 380       XPUSHs(&PL_sv_yes);
 381     }
 382
 383     /* /p */
 384     if (self->rx->intflags & RXf_PMf_KEEPCOPY) {
 385       XPUSHs(sv_2mortal(newSVpvs("p")));
 386       XPUSHs(&PL_sv_yes);
 387     }
 388
 389 void
 390 stash(re::engine::Plugin self, ...)
 391 PPCODE:
 392     if (items > 1) {
 393         self->stash = ST(1);
 394         SvREFCNT_inc(self->stash);
 395         XSRETURN_EMPTY;
 396     } else {
 397         XPUSHs(self->stash);
 398     }
 399
 400 void
 401 minlen(re::engine::Plugin self, ...)
 402 PPCODE:
 403     if (items > 1) {
 404         self->rx->minlen = (I32)SvIV(ST(1));
 405         XSRETURN_EMPTY;
 406     } else {
 407         if (self->rx->minlen) {
 408             XPUSHs(sv_2mortal(newSViv(self->rx->minlen)));
 409         } else {
 410             XPUSHs(sv_2mortal(&PL_sv_undef));
 411         }
 412     }
 413
 414 void
 415 gofs(re::engine::Plugin self, ...)
 416 PPCODE:
 417     if (items > 1) {
 418         self->rx->gofs = (U32)SvIV(ST(1));
 419         XSRETURN_EMPTY;
 420     } else {
 421         if (self->rx->gofs) {
 422             XPUSHs(sv_2mortal(newSVuv(self->rx->gofs)));
 423         } else {
 424             XPUSHs(sv_2mortal(&PL_sv_undef));
 425         }
 426     }
 427
 428 void
 429 nparens(re::engine::Plugin self, ...)
 430 PPCODE:
 431     if (items > 1) {
 432         self->rx->nparens = (U32)SvIV(ST(1));
 433         XSRETURN_EMPTY;
 434     } else {
 435         if (self->rx->nparens) {
 436             XPUSHs(sv_2mortal(newSVuv(self->rx->nparens)));
 437         } else {
 438             XPUSHs(sv_2mortal(&PL_sv_undef));
 439         }
 440     }
 441
 442 void
 443 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 444 PPCODE:
 445     if (items > 1) {
 446         self->cb_num_capture_buff_FETCH = ST(1);
 447         SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
 448     }
 449
 450 void
 451 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 452 PPCODE:
 453     if (items > 1) {
 454         self->cb_num_capture_buff_STORE = ST(1);
 455         SvREFCNT_inc(self->cb_num_capture_buff_STORE);
 456     }
 457
 458 void
 459 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 460 PPCODE:
 461     if (items > 1) {
 462         self->cb_num_capture_buff_LENGTH = ST(1);
 463         SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
 464     }
 465
 466 void
 467 ENGINE()
 468 PPCODE:
 469     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));