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     /* Precompiled pattern 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(aTHX_ "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     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 296
 297     callback = self->cb_num_capture_buff_LENGTH;
 298
 299     if (callback) {
 300         ENTER;
 301         SAVETMPS;
 302
 303         PUSHMARK(SP);
 304         XPUSHs(rx->pprivate);
 305         XPUSHs(sv_2mortal(newSViv(paren)));
 306         PUTBACK;
 307
 308         call_sv(callback, G_SCALAR);
 309
 310         SPAGAIN;
 311
 312         IV ret = POPi;
 313
 314         PUTBACK;
 315         FREETMPS;
 316         LEAVE;
 317
 318         return (I32)ret;
 319     } else {
 320         /* TODO: call FETCH and get the length on that value */
 321         return 0;
 322     }
 323 }
 324
 325
 326 SV*
 327 Plugin_named_buff (pTHX_ REGEXP * const rx, SV * const key, SV * const value,
 328                    const U32 flags)
 329 {
 330     return NULL;
 331 }
 332
 333 SV*
 334 Plugin_named_buff_iter (pTHX_ REGEXP * const rx, const SV * const lastkey,
 335                         const U32 flags)
 336 {
 337     return NULL;
 338 }
 339
 340 SV*
 341 Plugin_package(pTHX_ REGEXP * const rx)
 342 {
 343     PERL_UNUSED_ARG(rx);
 344     return newSVpvs("re::engine::Plugin");
 345 }
 346
 347 MODULE = re::engine::Plugin     PACKAGE = re::engine::Plugin
 348 PROTOTYPES: DISABLE
 349
 350 void
 351 pattern(re::engine::Plugin self, ...)
 352 PPCODE:
 353     XPUSHs(self->pattern);
 354
 355 void
 356 str(re::engine::Plugin self, ...)
 357 PPCODE:
 358     XPUSHs(self->str);
 359
 360 char*
 361 mod(re::engine::Plugin self, ...)
 362 PPCODE:
 363     /* /i */
 364     if (self->rx->intflags & PMf_FOLD) {
 365       XPUSHs(sv_2mortal(newSVpvs("i")));
 366       XPUSHs(&PL_sv_yes);
 367     }
 368
 369     /* /m */
 370     if (self->rx->intflags & PMf_MULTILINE) {
 371       XPUSHs(sv_2mortal(newSVpvs("m")));
 372       XPUSHs(&PL_sv_yes);
 373     }
 374
 375     /* /s */
 376     if (self->rx->intflags & PMf_SINGLELINE) {
 377       XPUSHs(sv_2mortal(newSVpvs("s")));
 378       XPUSHs(&PL_sv_yes);
 379     }
 380
 381     /* /x */
 382     if (self->rx->intflags & PMf_EXTENDED) {
 383       XPUSHs(sv_2mortal(newSVpvs("x")));
 384       XPUSHs(&PL_sv_yes);
 385     }
 386
 387     /* /p */
 388     if (self->rx->intflags & RXf_PMf_KEEPCOPY) {
 389       XPUSHs(sv_2mortal(newSVpvs("p")));
 390       XPUSHs(&PL_sv_yes);
 391     }
 392
 393 void
 394 stash(re::engine::Plugin self, ...)
 395 PPCODE:
 396     if (items > 1) {
 397         self->stash = ST(1);
 398         SvREFCNT_inc(self->stash);
 399         XSRETURN_EMPTY;
 400     } else {
 401         XPUSHs(self->stash);
 402     }
 403
 404 void
 405 minlen(re::engine::Plugin self, ...)
 406 PPCODE:
 407     if (items > 1) {
 408         self->rx->minlen = (I32)SvIV(ST(1));
 409         XSRETURN_EMPTY;
 410     } else {
 411         if (self->rx->minlen) {
 412             XPUSHs(sv_2mortal(newSViv(self->rx->minlen)));
 413         } else {
 414             XPUSHs(sv_2mortal(&PL_sv_undef));
 415         }
 416     }
 417
 418 void
 419 gofs(re::engine::Plugin self, ...)
 420 PPCODE:
 421     if (items > 1) {
 422         self->rx->gofs = (U32)SvIV(ST(1));
 423         XSRETURN_EMPTY;
 424     } else {
 425         if (self->rx->gofs) {
 426             XPUSHs(sv_2mortal(newSVuv(self->rx->gofs)));
 427         } else {
 428             XPUSHs(sv_2mortal(&PL_sv_undef));
 429         }
 430     }
 431
 432 void
 433 nparens(re::engine::Plugin self, ...)
 434 PPCODE:
 435     if (items > 1) {
 436         self->rx->nparens = (U32)SvIV(ST(1));
 437         XSRETURN_EMPTY;
 438     } else {
 439         if (self->rx->nparens) {
 440             XPUSHs(sv_2mortal(newSVuv(self->rx->nparens)));
 441         } else {
 442             XPUSHs(sv_2mortal(&PL_sv_undef));
 443         }
 444     }
 445
 446 void
 447 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 448 PPCODE:
 449     if (items > 1) {
 450         self->cb_num_capture_buff_FETCH = ST(1);
 451         SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
 452     }
 453
 454 void
 455 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 456 PPCODE:
 457     if (items > 1) {
 458         self->cb_num_capture_buff_STORE = ST(1);
 459         SvREFCNT_inc(self->cb_num_capture_buff_STORE);
 460     }
 461
 462 void
 463 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 464 PPCODE:
 465     if (items > 1) {
 466         self->cb_num_capture_buff_LENGTH = ST(1);
 467         SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
 468     }
 469
 470 void
 471 ENGINE()
 472 PPCODE:
 473     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));