ext/ByteLoader/ByteLoader.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 #include "byterun.h"
   6
   7 static int
   8 xgetc(PerlIO *io)
   9 {
  10     dTHX;
  11     return PerlIO_getc(io);
  12 }
  13
  14 static int
  15 xfread(char *buf, size_t size, size_t n, PerlIO *io)
  16 {
  17     dTHX;
  18     int i = PerlIO_read(io, buf, n * size);
  19     if (i > 0)
  20         i /= size;
  21     return i;
  22 }
  23
  24 static void
  25 freadpv(U32 len, void *data, XPV *pv)
  26 {
  27     dTHX;
  28     New(666, pv->xpv_pv, len, char);
  29     PerlIO_read((PerlIO*)data, (void*)pv->xpv_pv, len);
  30     pv->xpv_len = len;
  31     pv->xpv_cur = len - 1;
  32 }
  33
  34 static I32
  35 byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
  36 {
  37     dTHR;
  38     OP *saveroot = PL_main_root;
  39     OP *savestart = PL_main_start;
  40     struct bytestream bs;
  41
  42     bs.data = PL_rsfp;
  43     bs.pfgetc = (int(*) (void*))xgetc;
  44     bs.pfread = (int(*) (char*,size_t,size_t,void*))xfread;
  45     bs.pfreadpv = freadpv;
  46
  47     byterun(aTHXo_ bs);
  48
  49     if (PL_in_eval) {
  50         OP *o;
  51
  52         PL_eval_start = PL_main_start;
  53
  54         o = newSVOP(OP_CONST, 0, newSViv(1));
  55         PL_eval_root = newLISTOP(OP_LINESEQ, 0, PL_main_root, o);
  56         PL_main_root->op_next = o;
  57         PL_eval_root = newUNOP(OP_LEAVEEVAL, 0, PL_eval_root);
  58         o->op_next = PL_eval_root;
  59
  60         PL_main_root = saveroot;
  61         PL_main_start = savestart;
  62     }
  63
  64     return 0;
  65 }
  66
  67 MODULE = ByteLoader             PACKAGE = ByteLoader
  68
  69 PROTOTYPES:     ENABLE
  70
  71 void
  72 import(...)
  73   PPCODE:
  74     filter_add(byteloader_filter, NULL);
  75
  76 void
  77 unimport(...)
  78   PPCODE:
  79     filter_del(byteloader_filter);