#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "hook_op_check_smartmatch.h"
#define SMARTMATCH_HH_KEY "smartmatch/engine"
#ifndef op_append_elem
#define op_append_elem(a,b,c) Perl_op_append_elem(aTHX_ a,b,c)
OP *
Perl_op_append_elem(pTHX_ I32 type, OP *first, OP *last)
{
if (!first)
return last;
if (!last)
return first;
if (first->op_type != (unsigned)type
|| (type == OP_LIST && (first->op_flags & OPf_PARENS)))
{
return newLISTOP(type, 0, first, last);
}
if (first->op_flags & OPf_KIDS)
((LISTOP*)first)->op_last->op_sibling = last;
else {
first->op_flags |= OPf_KIDS;
((LISTOP*)first)->op_first = last;
}
((LISTOP*)first)->op_last = last;
return first;
}
#endif
STATIC OP*
smartmatch_cb(pTHX_ OP *o, void *user_data)
{
OP *left, *right, *cb_op, *list, *new;
SV **engine;
SV *cb_name;
engine = hv_fetchs(GvHV(PL_hintgv), SMARTMATCH_HH_KEY, 0);
if (!engine) {
return o;
}
left = cBINOPo->op_first;
right = left->op_sibling;
o->op_flags &= ~OPf_KIDS;
op_free(o);
/* array slices used to parse incorrectly (perl RT#77468),
* fix (hack) this up */
#if PERL_VERSION < 14
if (left->op_type == OP_ASLICE) {
OP *sib;
sib = left->op_sibling;
left->op_flags &= ~OPf_WANT_SCALAR;
left->op_flags |= OPf_WANT_LIST
| OPf_PARENS
| OPf_REF
| OPf_MOD
| OPf_STACKED
| OPf_SPECIAL;
left->op_sibling = NULL;
left = newLISTOP(OP_ANONLIST,
OPf_WANT_SCALAR|OPf_SPECIAL,
newOP(OP_PUSHMARK, 0),
left);
left->op_sibling = sib;
}
if (right->op_type == OP_ASLICE) {
OP *sib;
sib = right->op_sibling;
right->op_flags &= ~OPf_WANT_SCALAR;
right->op_flags |= OPf_WANT_LIST
| OPf_PARENS
| OPf_REF
| OPf_MOD
| OPf_STACKED
| OPf_SPECIAL;
right->op_sibling = NULL;
right = newLISTOP(OP_ANONLIST,
OPf_WANT_SCALAR|OPf_SPECIAL,
newOP(OP_PUSHMARK, 0),
right);
right->op_sibling = sib;
left->op_sibling = right;
}
#endif
cb_name = newSVpvs("smartmatch::engine::");
sv_catsv(cb_name, *engine);
sv_catpvs(cb_name, "::match");
cb_op = newUNOP(OP_RV2CV, 0, newGVOP(OP_GV, 0, gv_fetchsv(cb_name, 0, SVt_PVCV)));
list = newLISTOP(OP_LIST, 0, left, right);
new = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, list, cb_op));
SvREFCNT_dec(cb_name);
return new;
}
UV
hook_op_check_smartmatch()
{
return hook_op_check(OP_SMARTMATCH, smartmatch_cb, NULL);
}
MODULE = smartmatch PACKAGE = smartmatch
PROTOTYPES: DISABLE
BOOT:
hook_op_check_smartmatch();