/* allow push/set of single cv ref or array ref of cv refs */ int modperl_handler_perl_add_handlers(pTHX_ request_rec *r, conn_rec *c, server_rec *s, apr_pool_t *p, const char *name, SV *sv, modperl_handler_action_e action) { I32 i; AV *av = (AV *)NULL; MpAV **handlers = modperl_handler_get_handlers(r, c, s, p, name, action); if (!(handlers && *handlers)) { return FALSE; } if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV)) { av = (AV*)SvRV(sv); for (i=0; i <= AvFILL(av); i++) { sv = *av_fetch(av, i, FALSE); push_sv_handler; } } else { push_sv_handler; } return TRUE; }
std::vector<T> toMsgVec(SV* sv) { std::vector<T> return_vec; if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) Perl_croak(aTHX_ "Expected an array ref of messages"); AV* msg_av = (AV*) SvRV(sv); int length = AvFILL(msg_av) + 1; for (int i = 0; i < length; i++) { SV* el = *(av_fetch(msg_av, i, 0)); return_vec.push_back(toMsg<T>(el)); } return return_vec; }
mesos::perl::CommandArg sv_to_CommandArg(SV* msg) { if (SvTYPE(msg) == SVt_PV) { return mesos::perl::CommandArg(sv_to_string(msg)); } else if (!SvROK(msg)) { Perl_croak(aTHX_ "Must pass string or ref as command arg"); } else if (sv_isobject(msg)) { const char* type = sv_reftype(SvRV(msg), 1); return mesos::perl::CommandArg(sv_to_msg(msg), std::string(type)); } else if (SvTYPE(SvRV(msg)) == SVt_PVAV) { AV* args_av = (AV*) SvRV(msg); int length = AvFILL(args_av) + 1; std::vector<std::string> data_vec; for (int i = 0; i < length; i++) { SV* el = *(av_fetch(args_av, i, 0)); std::string data = sv_isobject(el) ? sv_to_msg(el) : sv_to_string(el); data_vec.push_back(data); } return mesos::perl::CommandArg(data_vec, av_type(args_av)); } // control shouldnt reach here, but compilers complain so just return empty command arg return mesos::perl::CommandArg(); }
SV * DeadCode(pTHX) { #ifdef PURIFY return Nullsv; #else SV* sva; SV* sv; SV* ret = newRV_noinc((SV*)newAV()); register SV* svend; int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0; for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) { svend = &sva[SvREFCNT(sva)]; for (sv = sva + 1; sv < svend; ++sv) { if (SvTYPE(sv) == SVt_PVCV) { CV *cv = (CV*)sv; AV* padlist = CvPADLIST(cv), *argav; SV** svp; SV** pad; int i = 0, j, levelm, totm = 0, levelref, totref = 0; int levels, tots = 0, levela, tota = 0, levelas, totas = 0; int dumpit = 0; if (CvXSUB(sv)) { continue; /* XSUB */ } if (!CvGV(sv)) { continue; /* file-level scope. */ } if (!CvROOT(cv)) { /* PerlIO_printf(Perl_debug_log, " no root?!\n"); */ continue; /* autoloading stub. */ } do_gvgv_dump(0, Perl_debug_log, "GVGV::GV", CvGV(sv)); if (CvDEPTH(cv)) { PerlIO_printf(Perl_debug_log, " busy\n"); continue; } svp = AvARRAY(padlist); while (++i <= AvFILL(padlist)) { /* Depth. */ SV **args; pad = AvARRAY((AV*)svp[i]); argav = (AV*)pad[0]; if (!argav || (SV*)argav == &PL_sv_undef) { PerlIO_printf(Perl_debug_log, " closure-template\n"); continue; } args = AvARRAY(argav); levelm = levels = levelref = levelas = 0; levela = sizeof(SV*) * (AvMAX(argav) + 1); if (AvREAL(argav)) { for (j = 0; j < AvFILL(argav); j++) { if (SvROK(args[j])) { PerlIO_printf(Perl_debug_log, " ref in args!\n"); levelref++; } /* else if (SvPOK(args[j]) && SvPVX(args[j])) { */ else if (SvTYPE(args[j]) >= SVt_PV && SvLEN(args[j])) { levelas += SvLEN(args[j])/SvREFCNT(args[j]); } } } for (j = 1; j < AvFILL((AV*)svp[1]); j++) { /* Vars. */ if (SvROK(pad[j])) { levelref++; do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); dumpit = 1; } /* else if (SvPOK(pad[j]) && SvPVX(pad[j])) { */ else if (SvTYPE(pad[j]) >= SVt_PVAV) { if (!SvPADMY(pad[j])) { levelref++; do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); dumpit = 1; } } else if (SvTYPE(pad[j]) >= SVt_PV && SvLEN(pad[j])) { levels++; levelm += SvLEN(pad[j])/SvREFCNT(pad[j]); /* Dump(pad[j],4); */ } } PerlIO_printf(Perl_debug_log, " level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", i, levelref, levelm, levels, levela, levelas); totm += levelm; tota += levela; totas += levelas; tots += levels; totref += levelref; if (dumpit) do_sv_dump(0, Perl_debug_log, (SV*)cv, 0, 2, 0, 0); } if (AvFILL(padlist) > 1) { PerlIO_printf(Perl_debug_log, " total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", totref, totm, tots, tota, totas); } tref += totref; tm += totm; ts += tots; ta += tota; tas += totas; } } } PerlIO_printf(Perl_debug_log, "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas); return ret; #endif /* !PURIFY */ }