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