MODULE = Embperl PACKAGE = Embperl PREFIX = embperl_ PROTOTYPES: ENABLE # /* ---- Helper ----- */ #if defined (__GNUC__) && defined (__i386__) void embperl_dbgbreak() CODE: __asm__ ("int $0x03\n") ; #endif double Clock() CODE: #ifdef CLOCKS_PER_SEC RETVAL = clock () * 1000 / CLOCKS_PER_SEC / 1000.0 ; #else RETVAL = clock () ; #endif OUTPUT: RETVAL void embperl_logerror(code, sText, pApacheReqSV=NULL) int code char * sText SV * pApacheReqSV PREINIT: tReq * r = CurrReq ; int bRestore = 0 ; #ifdef APACHE SV * pSaveApacheReqSV = NULL ; request_rec * pSaveApacheReq = NULL ; #endif CODE: #ifdef APACHE if (pApacheReqSV && r -> pApacheReq == NULL) { bRestore = 1 ; pSaveApacheReqSV = r -> pApacheReqSV ; pSaveApacheReq = r -> pApacheReq ; if (SvROK (pApacheReqSV)) r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV)); else r -> pApacheReq = NULL ; r -> pApacheReqSV = pApacheReqSV ; } #endif strncpy (r->errdat1, sText, sizeof (r->errdat1) - 1) ; LogError (r,code) ; #ifdef APACHE if (bRestore) { r -> pApacheReqSV = pSaveApacheReqSV ; r -> pApacheReq = pSaveApacheReq ; } #endif void embperl_log(sText) char * sText INIT: tReq * r = CurrReq ; CODE: if (r) lwrite (r->pApp,sText, strlen (sText)) ; else PerlIO_puts(PerlIO_stderr(), sText) ; void embperl_output(sText) SV * sText INIT: STRLEN l ; tReq * r = CurrReq ; CODE: { char * p = SvPV (sText, l) ; /*if Node_self(DomTree_self (r -> Component.xCurrDomTree), r -> Component.xCurrNode) -> nType == ntypDocumentFraq) Node_appendChild (DomTree_self (r -> Component.xCurrDomTree), r -> Component.xCurrNode, r -> Component.nCurrRepeatLevel, ntypCDATA, 0, p, l, 0, 0, NULL) ; else*/ r -> Component.xCurrNode = Node_insertAfter_CDATA (r->pApp, p, l, (r -> Component.nCurrEscMode & 3)== 3?1 + (r -> Component.nCurrEscMode & 4):r -> Component.nCurrEscMode, DomTree_self (r -> Component.xCurrDomTree), r -> Component.xCurrNode, r -> Component.nCurrRepeatLevel) ; r -> Component.bEscModeSet = 0 ; } int embperl_getlineno() INIT: tReq * r = CurrReq ; CODE: RETVAL = GetLineNo (r) ; OUTPUT: RETVAL void embperl_flushlog() CODE: FlushLog (CurrApp) ; char * embperl_Sourcefile() INIT: tReq * r = CurrReq ; CODE: RETVAL = r -> Component.sSourcefile ; OUTPUT: RETVAL void embperl_exit(...) CODE: /* from mod_perl's perl_util.c */ struct ufuncs umg; umg.uf_val = errgv_empty_set; umg.uf_set = errgv_empty_set; umg.uf_index = (IV)0; sv_magic(ERRSV, Nullsv, 'U', (char*) &umg, sizeof(umg)); ENTER; SAVESPTR(diehook); diehook = Nullsv; if (items > 0) croak("request %d", SvIV(ST(0))); else croak("component"); LEAVE; /* we don't get this far, but croak() will rewind */ sv_unmagic(ERRSV, 'U'); void embperl_ClearSymtab(sPackage,bDebug) char * sPackage int bDebug CODE: ClearSymtab (CurrReq, sPackage, bDebug) ; ################################################################################ MODULE = Embperl PACKAGE = Embperl::Req PREFIX = embperl_ void embperl_logerror(r,code, sText,pApacheReqSV=NULL) tReq * r int code char * sText SV * pApacheReqSV PREINIT: int bRestore = 0 ; #ifdef APACHE SV * pSaveApacheReqSV = NULL ; request_rec * pSaveApacheReq = NULL ; #endif CODE: #ifdef APACHE if (pApacheReqSV && r -> pApacheReq == NULL) { bRestore = 1 ; pSaveApacheReqSV = r -> pApacheReqSV ; pSaveApacheReq = r -> pApacheReq ; if (SvROK (pApacheReqSV)) r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV)); else r -> pApacheReq = NULL ; r -> pApacheReqSV = pApacheReqSV ; } #endif strncpy (r->errdat1, sText, sizeof (r->errdat1) - 1) ; LogError (r,code) ; #ifdef APACHE if (bRestore) { r -> pApacheReqSV = pSaveApacheReqSV ; r -> pApacheReq = pSaveApacheReq ; } #endif void embperl_output(r,sText) tReq * r char * sText CODE: OutputToHtml (r,sText) ; void embperl_log(r,sText) tReq * r char * sText CODE: lwrite (r->pApp, sText, strlen (sText)) ; void embperl_flushlog(r) tReq * r CODE: FlushLog (r->pApp) ; int embperl_getlineno(r) tReq * r CODE: RETVAL = GetLineNo (r) ; OUTPUT: RETVAL void log_svs(r,sText) tReq * r char * sText CODE: lprintf (r->pApp,"[%d]MEM: %s: SVs: %d OBJs: %d\n", r->pThread->nPid, sText, sv_count, sv_objcount) ; SV * embperl_Escape(r, str, mode) tReq * r char * str = NO_INIT int mode PREINIT: STRLEN len ; CODE: str = SvPV(ST(1),len) ; RETVAL = Escape(r, str, len, mode, NULL, 0) ; OUTPUT: RETVAL INCLUDE: Cmd.xs INCLUDE: DOM.xs INCLUDE: Syntax.xs # Reset Module, so we get the correct boot function MODULE = Embperl PACKAGE = Embperl PREFIX = embperl_