Plugin.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #define SAVEPVN(p,n)    ((p) ? savepvn(p,n) : NULL)
   6
   7 START_EXTERN_C
   8
   9 EXTERN_C const regexp_engine engine_plugin;
  10
  11 END_EXTERN_C
  12
  13 /*
  14  * Our struct which gets initiated and used as our object
  15  * ($re). Since we can't count on the regexp structure provided by
  16  * perl to be alive between comp/exec etc. we pull stuff from it and
  17  * save it in our own structure.
  18  *
  19  * Besides, creating Perl accessors which directly muck with perl's
  20  * own regexp structures in different phases of regex execution would
  21  * be a little too evil.
  22  */
  23 typedef struct replug {
  24     SV * pattern;
  25     char flags[sizeof("ecgimsxp")];
  26
  27     I32 minlen;
  28     U32 gofs;
  29
  30     SV * stash;
  31
  32     U32 nparens;
  33     AV * captures; /* Array of SV* that'll become $1, $2, ... */
  34 } *re__engine__Plugin;
  35
  36 SV*
  37 get_H_callback(const char* key)
  38 {
  39     dVAR;
  40     dSP;
  41
  42     SV * callback;
  43
  44     ENTER;
  45     SAVETMPS;
  46
  47     PUSHMARK(SP);
  48     XPUSHs(sv_2mortal(newSVpv(key, 0)));
  49     PUTBACK;
  50
  51     call_pv("re::engine::Plugin::get_callback", G_SCALAR);
  52
  53     SPAGAIN;
  54
  55     callback = POPs;
  56     SvREFCNT_inc(callback);
  57
  58     if (!SvROK(callback)) { callback = NULL; }// croak("ret value not a ref"); }
  59
  60     PUTBACK;
  61     FREETMPS;
  62     LEAVE;
  63
  64     return callback;
  65 }
  66
  67 /* just learn to use gdb you lazy bum! */
  68 #if 0
  69 void
  70 dump_r_info(const char* id, regexp *r)
  71 {
  72     warn("%s:", id);
  73     warn("\textflags = %d", r->extflags);
  74     warn("\tminlen = %d", r->minlen);
  75     warn("\tminlenren = %d", r->minlenret);
  76     warn("\tgofs = %d", r->gofs);
  77     warn("\tnparens = %d", r->nparens);
  78     warn("\tpprivate = %p", r->pprivate);
  79     warn("\tsubbeg = %s", r->subbeg);
  80     warn("\tsublen = %d", r->sublen);
  81     warn("\tprecomp = %s", r->precomp);
  82     warn("\tprelen = %d", r->prelen);
  83     warn("\twrapped = %s", r->wrapped);
  84     warn("\twraplen = %d", r->wraplen);
  85     warn("\tseen_evals = %d", r->seen_evals);
  86     warn("\trefcnt = %d", r->refcnt);
  87
  88 }
  89 #endif
  90
  91 regexp *
  92 Plugin_comp(pTHX_ char *exp, char *xend, PMOP *pm)
  93 {
  94     dSP;
  95     register regexp *r;
  96     int count;
  97
  98     /*
  99      * Allocate a new regexp struct, we must only write to the intflags,
 100      * engine and private members and the others must be populated,
 101      * internals expect the regex to have certain values least our code
 102      * blow up
 103      */
 104
 105     Newxz(r,1,regexp);
 106
 107     /* Set up the regex to be handled by this plugin */
 108     r->engine = &engine_plugin;
 109
 110     /* Store the initial flags */
 111     r->intflags = pm->op_pmflags;
 112     r->pprivate = NULL; /* this is set to our object below */
 113
 114     /*
 115      * Populate the regexp members for the engine
 116      */
 117
 118     /* Ref count of the pattern */
 119     r->refcnt = 1;
 120
 121     /* Preserve a copy of the original pattern */
 122     r->prelen = xend - exp;
 123     r->precomp = SAVEPVN(exp, r->prelen);
 124
 125     /* these may be changed by accessors */
 126     r->minlen = 0;
 127     r->minlenret = 0;
 128     r->gofs = 0;
 129     r->nparens = 0;
 130
 131     /* Store the flags as perl expects them */
 132     r->extflags = pm->op_pmflags & RXf_PMf_COMPILETIME;
 133
 134     /*
 135      * Construct a new B<re::engine::Plugin> object that'll carry around
 136      * our data inside C<< r->pprivate >>. The object is a blessed void*
 137      * that points to our replug struct which holds any state we want to
 138      * keep.
 139      */
 140     re__engine__Plugin re;
 141     Newz(0, re, 1, struct replug);
 142
 143     SV *obj = newSV(0);
 144     SvREFCNT_inc(obj);
 145
 146     /* Bless into this package; TODO: make it subclassable */
 147     const char * pkg = "re::engine::Plugin";
 148     /* bless it */
 149     sv_setref_pv(obj, pkg, (void*)re);
 150
 151     /* Store our private object */
 152     r->pprivate = obj;
 153
 154     re->pattern = newSVpvn(SAVEPVN(exp, xend - exp), xend - exp);
 155     SvREFCNT_inc(re->pattern);
 156
 157     /* Concat [ec]gimosxp (egimosxp & cgimosxp into) the flags string as
 158      * appropriate
 159      */
 160     if (r->intflags & PMf_EVAL)       { strcat(re->flags, "e"); }
 161     if (r->intflags & PMf_CONTINUE)   { strcat(re->flags, "c"); }
 162     if (r->intflags & PMf_GLOBAL)     { strcat(re->flags, "g"); }
 163     if (r->intflags & PMf_FOLD)       { strcat(re->flags, "i"); }
 164     if (r->intflags & PMf_MULTILINE)  { strcat(re->flags, "m"); }
 165     if (r->intflags & PMf_ONCE)       { strcat(re->flags, "o"); }
 166     if (r->intflags & PMf_SINGLELINE) { strcat(re->flags, "s"); }
 167     if (r->intflags & PMf_EXTENDED)   { strcat(re->flags, "x"); }
 168     if (((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY)) {
 169         strcat(re->flags, "p");
 170     }
 171
 172     /*
 173      * Call our callback function if one was defined, if not we've
 174      * already set up all the stuff we're going to to need for
 175      * subsequent exec and other calls
 176      */
 177     SV * callback = get_H_callback("comp");
 178
 179     if (callback) {
 180         ENTER;
 181         SAVETMPS;
 182
 183         PUSHMARK(SP);
 184         XPUSHs(obj);
 185         XPUSHs(sv_2mortal(newSVpv(exp, xend - exp)));
 186
 187         PUTBACK;
 188
 189         call_sv(get_H_callback("comp"), G_DISCARD);
 190
 191         FREETMPS;
 192         LEAVE;
 193     }
 194
 195     /* If any of the comp-time accessors were called we'll have to
 196      * update the regexp struct with the new info.
 197      */
 198     if (re->minlen)  r->minlen  = re->minlen;
 199     if (re->gofs)    r->gofs    = re->gofs;
 200     if (re->gofs)    r->gofs    = re->gofs;
 201     if (re->nparens) r->nparens = re->nparens;
 202
 203     int buffers = r->nparens;
 204
 205     //r->nparens = (buffers - 1);
 206     Newxz(r->startp, buffers, I32);
 207     Newxz(r->endp, buffers, I32);
 208
 209     /* return the regexp */
 210     return r;
 211 }
 212
 213 I32
 214 Plugin_exec(pTHX_ register regexp *r, char *stringarg, register char *strend,
 215                   char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 216 {
 217     dSP;
 218     I32 rc;
 219     int *ovector;
 220     I32 i;
 221     int count;
 222     int ret;
 223
 224     /*Newx(ovector,r->nparens,int);*/
 225
 226     SV* callback = get_H_callback("exec");
 227
 228     ENTER;
 229     SAVETMPS;
 230
 231     PUSHMARK(SP);
 232
 233     XPUSHs(r->pprivate);
 234     XPUSHs(sv);
 235
 236     PUTBACK;
 237
 238     count = call_sv(callback, G_ARRAY);
 239
 240     SPAGAIN;
 241
 242     SV * SvRet = POPs;
 243
 244     if (SvTRUE(SvRet)) {
 245         /* Match vars */
 246
 247         /*
 248         r->sublen = strend-strbeg;
 249         r->subbeg = savepvn(strbeg,r->sublen);
 250         r->startp[1] = 0;
 251         r->endp[1] = 5;
 252         */
 253
 254         ret = 1;
 255     } else {
 256         ret = 0;
 257     }
 258
 259     PUTBACK;
 260     FREETMPS;
 261     LEAVE;
 262
 263     return ret;
 264 }
 265
 266 char *
 267 Plugin_intuit(pTHX_ regexp *prog, SV *sv, char *strpos,
 268                      char *strend, U32 flags, re_scream_pos_data *data)
 269 {
 270     return NULL;
 271 }
 272
 273 SV *
 274 Plugin_checkstr(pTHX_ regexp *prog)
 275 {
 276     return NULL;
 277 }
 278
 279 void
 280 Plugin_free(pTHX_ struct regexp *r)
 281 {
 282     /*sv_2mortal(r->pprivate);*/
 283     /*PerlMemShared_free(r->pprivate);*/
 284 }
 285
 286 void *
 287 Plugin_dupe(pTHX_ const regexp *r, CLONE_PARAMS *param)
 288 {
 289     return r->pprivate;
 290 }
 291
 292 SV*
 293 Plugin_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv)
 294 {
 295     return NULL;
 296 }
 297
 298 SV*
 299 Plugin_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags)
 300 {
 301     return NULL;
 302 }
 303
 304 /*
 305  * The function pointers we're telling the regex engine to use
 306  */
 307 const regexp_engine engine_plugin = {
 308         Plugin_comp,
 309         Plugin_exec,
 310         Plugin_intuit,
 311         Plugin_checkstr,
 312         Plugin_free,
 313         Plugin_numbered_buff_get,
 314         Plugin_named_buff_get,
 315 #if defined(USE_ITHREADS)
 316         Plugin_dupe,
 317 #endif
 318 };
 319
 320 MODULE = re::engine::Plugin     PACKAGE = re::engine::Plugin
 321
 322 SV *
 323 pattern(re::engine::Plugin self, ...)
 324 CODE:
 325     SvREFCNT_inc(self->pattern);
 326     RETVAL = self->pattern;
 327 OUTPUT:
 328     RETVAL
 329
 330 char*
 331 flags(re::engine::Plugin self, ...)
 332 CODE:
 333     RETVAL = self->flags;
 334 OUTPUT:
 335     RETVAL
 336
 337 SV *
 338 stash(re::engine::Plugin self, ...)
 339 PREINIT:
 340     SV * stash;
 341 CODE:
 342     if (items > 1) {
 343         self->stash = sv_mortalcopy(ST(1));
 344         SvREFCNT_inc(self->stash);
 345     }
 346     SvREFCNT_inc(self->stash);
 347     RETVAL = self->stash;
 348 OUTPUT:
 349     RETVAL
 350
 351 SV *
 352 minlen(re::engine::Plugin self, ...)
 353 CODE:
 354     if (items > 1) {
 355         self->minlen = (I32)SvIV(ST(1));
 356     }
 357
 358     RETVAL = self->minlen ? newSViv(self->minlen) : &PL_sv_undef;
 359 OUTPUT:
 360     RETVAL
 361
 362 SV *
 363 gofs(re::engine::Plugin self, ...)
 364 CODE:
 365     if (items > 1) {
 366         self->gofs = (U32)SvIV(ST(1));
 367     }
 368     RETVAL = self->gofs ? newSVuv(self->gofs) : &PL_sv_undef;
 369 OUTPUT:
 370     RETVAL
 371
 372 SV *
 373 nparens(re::engine::Plugin self, ...)
 374 CODE:
 375     if (items > 1) {
 376         self->nparens = (U32)SvIV(ST(1));
 377     }
 378     RETVAL = self->gofs ? newSVuv(self->gofs) : &PL_sv_undef;
 379 OUTPUT:
 380     RETVAL
 381
 382 void
 383 captures(re::engine::Plugin self, ...)
 384 PPCODE:
 385     if (items > 1) {
 386         self->minlen = (I32)SvIV(ST(1));
 387     }
 388     XPUSHs(sv_2mortal(newSViv(5)));
 389     XPUSHs(sv_2mortal(newSViv(10)));
 390
 391 void
 392 get_engine_plugin()
 393 PPCODE:
 394     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));