t/re-engine-Hooks-TestDist/TestDist.xs

   1 /* This file is part of the re::engine::Hooks Perl module.
   2  * See http://search.cpan.org/dist/re-engine-Hooks/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #include "re_engine_hooks.h"
  10
  11 #define __PACKAGE__     "re::engine::Hooks::TestDist"
  12 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  13
  14 #include "regcomp.h"
  15
  16 STATIC SV *reht_foo_var;
  17
  18 #define REHT_PUSH_NODE_NAME(V, P) do { \
  19  if (V) {                              \
  20   SV *sv = newSVpvn(P, sizeof(P) - 1); \
  21   sv_catpv(sv, PL_reg_name[OP(node)]); \
  22   av_push((AV *) SvRV(V), sv);         \
  23  } } while (0)
  24
  25 STATIC void reht_foo_comp_node(pTHX_ regexp *rx, regnode *node) {
  26  REHT_PUSH_NODE_NAME(reht_foo_var, "c:");
  27 }
  28
  29 STATIC void reht_foo_exec_node(pTHX_ regexp *rx, regnode *node, regmatch_info *reginfo, regmatch_state *st) {
  30  REHT_PUSH_NODE_NAME(reht_foo_var, "e:");
  31 }
  32
  33 STATIC SV *reht_bar_var;
  34
  35 STATIC void reht_bar_comp_node(pTHX_ regexp *rx, regnode *node) {
  36  REHT_PUSH_NODE_NAME(reht_bar_var, "c:");
  37 }
  38
  39 STATIC void reht_bar_exec_node(pTHX_ regexp *rx, regnode *node, regmatch_info *reginfo, regmatch_state *st) {
  40  REHT_PUSH_NODE_NAME(reht_bar_var, "e:");
  41 }
  42
  43 STATIC SV *reht_custom_var;
  44
  45 STATIC void reht_custom_comp_node(pTHX_ regexp *rx, regnode *node) {
  46  const char *node_name;
  47
  48  node_name = PL_reg_name[OP(node)];
  49 }
  50
  51 STATIC struct re_save_state reht_state_bak;
  52
  53 STATIC void reht_custom_exec_node(pTHX_ regexp *rx, regnode *node, regmatch_info *reginfo, regmatch_state *st) {
  54  STRLEN      node_namelen;
  55  const char *node_name;
  56
  57  node_name    = PL_reg_name[OP(node)];
  58  node_namelen = strlen(node_name);
  59
  60  /* The global regexp state may be overwritten if the Perl callback does a
  61   * regexp match. */
  62  reht_state_bak = PL_reg_state;
  63
  64  dSP;
  65
  66  ENTER;
  67  SAVETMPS;
  68
  69  PUSHMARK(SP);
  70  EXTEND(SP, 1);
  71  mPUSHp(node_name, node_namelen);
  72  PUTBACK;
  73
  74  call_sv(reht_custom_var, G_VOID | G_EVAL);
  75
  76  FREETMPS;
  77  LEAVE;
  78
  79  PL_reg_state = reht_state_bak;
  80 }
  81
  82 /* --- XS ------------------------------------------------------------------ */
  83
  84 MODULE = re::engine::Hooks::TestDist    PACKAGE = re::engine::Hooks::TestDist
  85
  86 PROTOTYPES: ENABLE
  87
  88 BOOT:
  89 {
  90  {
  91   reh_config foo_cfg;
  92   foo_cfg.comp_node = reht_foo_comp_node;
  93   foo_cfg.exec_node = reht_foo_exec_node;
  94   reh_register(__PACKAGE__ "::foo", &foo_cfg);
  95   reht_foo_var = NULL;
  96  }
  97
  98  {
  99   reh_config bar_cfg;
 100   bar_cfg.comp_node = reht_bar_comp_node;
 101   bar_cfg.exec_node = reht_bar_exec_node;
 102   reh_register(__PACKAGE__ "::bar", &bar_cfg);
 103   reht_bar_var = NULL;
 104  }
 105
 106  {
 107   reh_config custom_cfg;
 108   custom_cfg.comp_node = reht_custom_comp_node;
 109   custom_cfg.exec_node = reht_custom_exec_node;
 110   reh_register(__PACKAGE__ "::custom", &custom_cfg);
 111   reht_custom_var = NULL;
 112  }
 113 }
 114
 115 void
 116 set_variable(SV *key, SV *var)
 117 PROTOTYPE: $$
 118 PREINIT:
 119  STRLEN      len;
 120  const char *s;
 121 PPCODE:
 122  s = SvPV(key, len);
 123  if (len == 3 && strcmp(s, "foo") == 0) {
 124   if (!SvROK(var) || SvTYPE(SvRV(var)) != SVt_PVAV)
 125    croak("Invalid variable type");
 126   SvREFCNT_dec(reht_foo_var);
 127   reht_foo_var = SvREFCNT_inc(var);
 128  } else if (len == 3 && strcmp(s, "bar") == 0) {
 129   if (!SvROK(var) || SvTYPE(SvRV(var)) != SVt_PVAV)
 130    croak("Invalid variable type");
 131   SvREFCNT_dec(reht_bar_var);
 132   reht_bar_var = SvREFCNT_inc(var);
 133  } else if (len == 6 && strcmp(s, "custom") == 0) {
 134   SvREFCNT_dec(reht_custom_var);
 135   reht_custom_var = SvREFCNT_inc(var);
 136  }
 137  XSRETURN(0);