void modperl_perl_exit(pTHX_ int status) { ENTER; SAVESPTR(PL_diehook); PL_diehook = (SV *)NULL; modperl_croak(aTHX_ MODPERL_RC_EXIT, "ModPerl::Util::exit"); }
static int output_body_obj(request_rec *r, SV *obj, int type) { dTHX; SV *buf_sv; apr_off_t clen = 0; STRLEN len; dSP; char *buf; int count; if (type == SVt_PVMG && !respond_to(obj, "getline")) { server_error(r, "response body object must be able to getline"); return HTTP_INTERNAL_SERVER_ERROR; } ENTER; SAVETMPS; SAVESPTR(PL_rs); PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE)); while (1) { PUSHMARK(SP); XPUSHs(obj); PUTBACK; count = call_method("getline", G_SCALAR); if (count != 1) croak("Big trouble\n"); SPAGAIN; buf_sv = POPs; if (SvOK(buf_sv)) { buf = SvPV(buf_sv, len); clen += len; ap_rwrite(buf, len, r); } else { break; } } if (clen > 0) { ap_set_content_length(r, clen); } PUSHMARK(SP); XPUSHs(obj); PUTBACK; call_method("close", G_DISCARD); SPAGAIN; PUTBACK; FREETMPS; LEAVE; return OK; }
START_MY_CXT #define fdebug (MY_CXT.x_fdebug) #define current_idx (MY_CXT.x_current_idx) static I32 filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) { dMY_CXT; SV *my_sv = FILTER_DATA(idx); char *nl = "\n"; char *p; char *out_ptr; int n; if (fdebug) warn("**** In filter_call - maxlen = %d, out len buf = %d idx = %d my_sv = %d [%s]\n", maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ; while (1) { /* anything left from last time */ if ((n = SvCUR(my_sv))) { out_ptr = SvPVX(my_sv) + BUF_OFFSET(my_sv) ; if (maxlen) { /* want a block */ if (fdebug) warn("BLOCK(%d): size = %d, maxlen = %d\n", idx, n, maxlen) ; sv_catpvn(buf_sv, out_ptr, maxlen > n ? n : maxlen ); if(n <= maxlen) { BUF_OFFSET(my_sv) = 0 ; SET_LEN(my_sv, 0) ; } else { BUF_OFFSET(my_sv) += maxlen ; SvCUR_set(my_sv, n - maxlen) ; } return SvCUR(buf_sv); } else { /* want lines */ if ((p = ninstr(out_ptr, out_ptr + n, nl, nl + 1))) { sv_catpvn(buf_sv, out_ptr, p - out_ptr + 1); n = n - (p - out_ptr + 1); BUF_OFFSET(my_sv) += (p - out_ptr + 1); SvCUR_set(my_sv, n) ; if (fdebug) warn("recycle %d - leaving %d, returning %d [%s]", idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ; return SvCUR(buf_sv); } else /* no EOL, so append the complete buffer */ sv_catpvn(buf_sv, out_ptr, n) ; } } SET_LEN(my_sv, 0) ; BUF_OFFSET(my_sv) = 0 ; if (FILTER_ACTIVE(my_sv)) { dSP ; int count ; if (fdebug) warn("gonna call %s::filter\n", PERL_MODULE(my_sv)) ; ENTER ; SAVETMPS; SAVEINT(current_idx) ; /* save current idx */ current_idx = idx ; SAVESPTR(DEFSV) ; /* save $_ */ /* make $_ use our buffer */ DEFSV = sv_2mortal(newSVpv("", 0)) ; PUSHMARK(sp) ; if (CODE_REF(my_sv)) { /* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */ count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR); } else { XPUSHs((SV*)PERL_OBJECT(my_sv)) ; PUTBACK ; count = perl_call_method("filter", G_SCALAR); } SPAGAIN ; if (count != 1) croak("Filter::Util::Call - %s::filter returned %d values, 1 was expected \n", PERL_MODULE(my_sv), count ) ; n = POPi ; if (fdebug) warn("status = %d, length op buf = %d [%s]\n", n, SvCUR(DEFSV), SvPVX(DEFSV) ) ; if (SvCUR(DEFSV)) sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ; PUTBACK ; FREETMPS ; LEAVE ; } else n = FILTER_READ(idx + 1, my_sv, maxlen) ; if (n <= 0) { /* Either EOF or an error */ if (fdebug) warn ("filter_read %d returned %d , returning %d\n", idx, n, (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n); /* PERL_MODULE(my_sv) ; */ /* PERL_OBJECT(my_sv) ; */ filter_del(filter_call); /* If error, return the code */ if (n < 0) return n ; /* return what we have so far else signal eof */ return (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n; } } }