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