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     /* Store the current str for ->str */
 130     self->str = (SV*)sv;
 131     SvREFCNT_inc(self->str);
 132
 133     ENTER;
 134     SAVETMPS;
 135
 136     PUSHMARK(SP);
 137     XPUSHs(rx->pprivate);
 138     XPUSHs(sv);
 139     PUTBACK;
 140
 141     call_sv(callback, G_SCALAR);
 142
 143     SPAGAIN;
 144
 145     SV * ret = POPs;
 146
 147     if (SvTRUE(ret))
 148         matched = 1;
 149     else
 150         matched = 0;
 151
 152     PUTBACK;
 153     FREETMPS;
 154     LEAVE;
 155
 156     return matched;
 157 }
 158
 159 char *
 160 Plugin_intuit(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 161                      char *strend, U32 flags, re_scream_pos_data *data)
 162 {
 163     PERL_UNUSED_ARG(rx);
 164     PERL_UNUSED_ARG(sv);
 165     PERL_UNUSED_ARG(strpos);
 166     PERL_UNUSED_ARG(strend);
 167     PERL_UNUSED_ARG(flags);
 168     PERL_UNUSED_ARG(data);
 169     return NULL;
 170 }
 171
 172 SV *
 173 Plugin_checkstr(pTHX_ REGEXP * const rx)
 174 {
 175     PERL_UNUSED_ARG(rx);
 176     return NULL;
 177 }
 178
 179 void
 180 Plugin_free(pTHX_ REGEXP * const rx)
 181 {
 182     PERL_UNUSED_ARG(rx);
 183 /*
 184     dSP;
 185     SV * callback;
 186     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 187
 188     callback = self->cb_free;
 189
 190     if (callback) {
 191         ENTER;
 192         SAVETMPS;
 193
 194         PUSHMARK(SP);
 195         XPUSHs(rx->pprivate);
 196         PUTBACK;
 197
 198         call_sv(callback, G_DISCARD);
 199
 200         PUTBACK;
 201         FREETMPS;
 202         LEAVE;
 203     }
 204     return;
 205 */
 206 }
 207
 208 void *
 209 Plugin_dupe(pTHX_ const REGEXP * rx, CLONE_PARAMS *param)
 210 {
 211     Perl_croak("dupe not supported yet");
 212     return rx->pprivate;
 213 }
 214
 215
 216 void
 217 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const rx, const I32 paren,
 218                            SV * const sv)
 219 {
 220     dSP;
 221     I32 items;
 222     SV * callback;
 223     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 224
 225     callback = self->cb_num_capture_buff_FETCH;
 226
 227     if (callback) {
 228         ENTER;
 229         SAVETMPS;
 230
 231         PUSHMARK(SP);
 232         XPUSHs(rx->pprivate);
 233         XPUSHs(sv_2mortal(newSViv(paren)));
 234         PUTBACK;
 235
 236         items = call_sv(callback, G_SCALAR);
 237
 238         if (items == 1) {
 239             SPAGAIN;
 240
 241             SV * ret = POPs;
 242             sv_setsv(sv, ret);
 243         } else {
 244             sv_setsv(sv, &PL_sv_undef);
 245         }
 246
 247         PUTBACK;
 248         FREETMPS;
 249         LEAVE;
 250     } else {
 251         sv_setsv(sv, &PL_sv_undef);
 252     }
 253 }
 254
 255 void
 256 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const rx, const I32 paren,
 257                            SV const * const value)
 258 {
 259     dSP;
 260     I32 items;
 261     SV * callback;
 262     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 263
 264     callback = self->cb_num_capture_buff_STORE;
 265
 266     if (callback) {
 267         ENTER;
 268         SAVETMPS;
 269
 270         PUSHMARK(SP);
 271         XPUSHs(rx->pprivate);
 272         XPUSHs(sv_2mortal(newSViv(paren)));
 273         XPUSHs(SvREFCNT_inc(value));
 274         PUTBACK;
 275
 276         call_sv(callback, G_DISCARD);
 277
 278         PUTBACK;
 279         FREETMPS;
 280         LEAVE;
 281     }
 282 }
 283
 284 I32
 285 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const rx, const SV * const sv,
 286                               const I32 paren)
 287 {
 288     dSP;
 289     I32 items;
 290     SV * callback;
 291     re__engine__Plugin self;
 292
 293     SELF_FROM_PPRIVATE(self,rx->pprivate);
 294
 295     callback = self->cb_num_capture_buff_LENGTH;
 296
 297     if (callback) {
 298         ENTER;
 299         SAVETMPS;
 300
 301         PUSHMARK(SP);
 302         XPUSHs(rx->pprivate);
 303         XPUSHs(sv_2mortal(newSViv(paren)));
 304         PUTBACK;
 305
 306         call_sv(callback, G_SCALAR);
 307
 308         SPAGAIN;
 309
 310         IV ret = POPi;
 311
 312         PUTBACK;
 313         FREETMPS;
 314         LEAVE;
 315
 316         return (I32)ret;
 317     } else {
 318         /* TODO: call FETCH and get the length on that value */
 319         return 0;
 320     }
 321 }
 322
 323
 324 SV*
 325 Plugin_named_buff_FETCH(pTHX_ REGEXP * const rx, SV * const key, U32 flags)
 326 {
 327     PERL_UNUSED_ARG(rx);
 328     PERL_UNUSED_ARG(key);
 329     PERL_UNUSED_ARG(flags);
 330
 331     return NULL;
 332 }
 333
 334 SV*
 335 Plugin_package(pTHX_ REGEXP * const rx)
 336 {
 337     PERL_UNUSED_ARG(rx);
 338     return newSVpvs("re::engine::Plugin");
 339 }
 340
 341 MODULE = re::engine::Plugin     PACKAGE = re::engine::Plugin
 342 PROTOTYPES: ENABLE
 343
 344 SV *
 345 pattern(re::engine::Plugin self, ...)
 346 CODE:
 347     SvREFCNT_inc(self->pattern);
 348     RETVAL = self->pattern;
 349 OUTPUT:
 350     RETVAL
 351
 352 SV *
 353 str(re::engine::Plugin self, ...)
 354 CODE:
 355     SvREFCNT_inc(self->str);
 356     RETVAL = self->str;
 357 OUTPUT:
 358     RETVAL
 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 SV *
 394 stash(re::engine::Plugin self, ...)
 395 PREINIT:
 396     SV * stash;
 397 CODE:
 398     if (items > 1) {
 399         self->stash = sv_mortalcopy(ST(1));
 400         SvREFCNT_inc(self->stash);
 401     }
 402     SvREFCNT_inc(self->stash);
 403     RETVAL = self->stash;
 404 OUTPUT:
 405     RETVAL
 406
 407 SV *
 408 minlen(re::engine::Plugin self, ...)
 409 CODE:
 410     if (items > 1) {
 411         self->rx->minlen = (I32)SvIV(ST(1));
 412     }
 413
 414     RETVAL = self->rx->minlen ? newSViv(self->rx->minlen) : &PL_sv_undef;
 415 OUTPUT:
 416     RETVAL
 417
 418 SV *
 419 gofs(re::engine::Plugin self, ...)
 420 CODE:
 421     if (items > 1) {
 422         self->rx->gofs = (U32)SvIV(ST(1));
 423     }
 424     RETVAL = self->rx->gofs ? newSVuv(self->rx->gofs) : &PL_sv_undef;
 425 OUTPUT:
 426     RETVAL
 427
 428 SV *
 429 nparens(re::engine::Plugin self, ...)
 430 CODE:
 431     if (items > 1) {
 432         self->rx->nparens = (U32)SvIV(ST(1));
 433     }
 434     RETVAL = self->rx->nparens ? newSVuv(self->rx->nparens) : &PL_sv_undef;
 435 OUTPUT:
 436     RETVAL
 437
 438 void
 439 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 440 PPCODE:
 441     if (items > 1) {
 442         self->cb_num_capture_buff_FETCH = ST(1);
 443         SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
 444     }
 445
 446 void
 447 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 448 PPCODE:
 449     if (items > 1) {
 450         self->cb_num_capture_buff_STORE = ST(1);
 451         SvREFCNT_inc(self->cb_num_capture_buff_STORE);
 452     }
 453
 454 void
 455 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 456 PPCODE:
 457     if (items > 1) {
 458         self->cb_num_capture_buff_LENGTH = ST(1);
 459         SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
 460     }
 461
 462 void
 463 ENGINE()
 464 PPCODE:
 465     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));