OP * clone_op(pTHX_ const OP * const o, const unsigned int paramcount) { OP * clone = NULL; if (o->op_type == OP_LEAVESUB) return clone_op(cUNOPo->op_first, paramcount); else if (o->op_flags & OPf_KIDS) { OP *kid = cUNOPo->op_first; OP *first = NULL; OP *last = NULL; do { OP * child = clone_op(kid, paramcount); if (!child) continue; clone = op_append_elem(o->op_type, clone, child); } while (kid = kid->op_sibling); return clone; } else switch (o->op_type) { case OP_CONST: return newSVOP(o->op_type, 0, cSVOPo_sv); case OP_PUSHMARK: return newOP(o->op_type, 0); case OP_NEXTSTATE: return newSTATEOP((U8)o->op_flags, NULL, NULL); case OP_NULL: return NULL; default: croak("Unsupported op type: %s", PL_op_name[o->op_type]); } }
static OP *parser_callback(pTHX_ GV *namegv, SV *psobj, U32 *flagsp) { dSP; SV *args_generator; SV *statement = NULL; I32 count; /* call the parser callback * it should take no arguments and return a coderef which, when called, * produces the arguments to the keyword function * the optree we want to generate is for something like * mykeyword($code->()) * where $code is the thing returned by the parser function */ PUSHMARK(SP); mXPUSHp(GvNAME(namegv), GvNAMELEN(namegv)); PUTBACK; count = call_sv(psobj, G_ARRAY); SPAGAIN; if (count > 1) { statement = POPs; } args_generator = SvREFCNT_inc(POPs); PUTBACK; if (!SvROK(args_generator) || SvTYPE(SvRV(args_generator)) != SVt_PVCV) { croak("The parser function for %s must return a coderef, not %"SVf, GvNAME(namegv), args_generator); } if (SvTRUE(statement)) { *flagsp |= CALLPARSER_STATEMENT; } return newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, newSVOP(OP_CONST, 0, args_generator))); }