/*################################################################################### # # Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de # Embperl - Copyright (c) 2008-2015 Gerald Richter # Embperl - Copyright (c) 2015-2023 actevy.io # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # ###################################################################################*/ #include "ep.h" #include "epmacro.h" struct tEmbperlCmd { int bValid ; const char * * sPerlCode ; /* perl code that should be inserted (maybe an array) */ const char * * sCompileTimePerlCode ; /* perl code that should be directly executed (maybe an array) */ const char * sCompileTimePerlCodeEnd ; /* perl code that should be directly executed at the end tag */ const char * sPerlCodeEnd ; /* perl code that should be inserted at the end tag */ const char * sStackName ; const char * sPushStack ; const char * sPopStack ; const char * sMatchStack ; const char * sStackName2 ; const char * sPushStack2 ; const char * sPopStack2 ; int numPerlCode ; int numCompileTimePerlCode ; int bRemoveNode ; int bPerlCodeRemove ; int bCompileChilds ; int nNodeType ; int nSwitchCodeType ; int bCallReturn ; const char * sMayJump ; struct tEmbperlCmd * pNext ; } ; typedef struct tEmbperlCmd tEmbperlCmd ; struct tEmbperlCompilerInfo { tStringIndex nMaxEmbperlCmd ; tEmbperlCmd * pEmbperlCmds ; } ; typedef struct tEmbperlCompilerInfo tEmbperlCompilerInfo ; /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileInit */ /* */ /* */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileInit (/*in*/ tApp * a, /*out*/ tEmbperlCompilerInfo * * ppInfo) { epaTHX_ tEmbperlCompilerInfo * pInfo = malloc (sizeof (tEmbperlCompilerInfo)) ; if (!pInfo) return rcOutOfMemory ; ArrayNewZero (a, &pInfo -> pEmbperlCmds, 256, sizeof (struct tEmbperlCmd)) ; ArraySet (a, &pInfo -> pEmbperlCmds, 0) ; pInfo -> nMaxEmbperlCmd = 1 ; *ppInfo = pInfo ; return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileInitItem */ /* */ /* */ /* */ /* ------------------------------------------------------------------------ */ int embperl_CompileInitItem (/*i/o*/ register req * r, /*in*/ HV * pHash, /*in*/ int nNodeName, /*in*/ int nNodeType, /*in*/ int nTagSet, /*in*/ void * * ppInfo) { epTHX_ SV * * ppSV ; AV * pAV ; tEmbperlCmd * pCmd ; tEmbperlCompilerInfo * pInfo = (tEmbperlCompilerInfo *)*ppInfo ; if (!pInfo) embperl_CompileInit (r -> pApp, (tEmbperlCompilerInfo * *)ppInfo) ; pInfo = (tEmbperlCompilerInfo *)*ppInfo ; ArraySet (r -> pApp, &pInfo -> pEmbperlCmds, nNodeName+1) ; if (pInfo -> nMaxEmbperlCmd < nNodeName) pInfo -> nMaxEmbperlCmd = nNodeName ; pCmd = &pInfo -> pEmbperlCmds[nNodeName] ; if (pCmd -> bValid) { tEmbperlCmd * pNewCmd ; if (pCmd -> bValid == nTagSet) return ok ; while (pCmd -> pNext) { if (pCmd -> bValid == nTagSet) return ok ; pCmd = pCmd -> pNext ; } if (pCmd -> bValid == nTagSet) return ok ; pNewCmd = malloc (sizeof (*pNewCmd)) ; pCmd -> pNext = pNewCmd ; pCmd = pNewCmd ; memset (pCmd, 0, sizeof(*pCmd)) ; } pCmd -> bValid = nTagSet ; ppSV = hv_fetch(pHash, "perlcode", 8, 0) ; if (ppSV != NULL && *ppSV != NULL && SvROK(*ppSV) && SvTYPE((pAV = (AV *)SvRV(*ppSV))) == SVt_PVAV) { /* Array reference */ int f = AvFILL(pAV) + 1 ; int i ; STRLEN l ; pCmd -> sPerlCode = malloc (f * sizeof (char *)) ; pCmd -> numPerlCode = f ; for (i = 0; i < f; i++) { ppSV = av_fetch (pAV, i, 0) ; if (ppSV && *ppSV) pCmd -> sPerlCode[i] = strdup (SvPV (*ppSV, l)) ; else pCmd -> sPerlCode[i] = NULL ; } } else { if (ppSV) { STRLEN l ; pCmd -> sPerlCode = malloc (sizeof (char *)) ; pCmd -> numPerlCode = 1 ; pCmd -> sPerlCode[0] = sstrdup (r, SvPV (*ppSV, l)) ; } } ppSV = hv_fetch(pHash, "compiletimeperlcode", 19, 0) ; if (ppSV != NULL && *ppSV != NULL && SvROK(*ppSV) && SvTYPE((pAV = (AV *)SvRV(*ppSV))) == SVt_PVAV) { /* Array reference */ int f = AvFILL(pAV) + 1 ; int i ; STRLEN l ; pCmd -> sCompileTimePerlCode = malloc (f * sizeof (char *)) ; pCmd -> numCompileTimePerlCode = f ; for (i = 0; i < f; i++) { ppSV = av_fetch (pAV, i, 0) ; if (ppSV && *ppSV) pCmd -> sCompileTimePerlCode[i] = strdup (SvPV (*ppSV, l)) ; else pCmd -> sCompileTimePerlCode[i] = NULL ; } } else { if (ppSV) { STRLEN l ; pCmd -> sCompileTimePerlCode = malloc (sizeof (char *)) ; pCmd -> numCompileTimePerlCode = 1 ; pCmd -> sCompileTimePerlCode[0] = sstrdup (r, SvPV (*ppSV, l)) ; } } pCmd -> sPerlCodeEnd = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "perlcodeend", NULL) ; pCmd -> sCompileTimePerlCodeEnd = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "compiletimeperlcodeend", NULL) ; pCmd -> sStackName = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "stackname", NULL) ; pCmd -> sPushStack = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "push", NULL) ; pCmd -> sPopStack = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "pop", NULL) ; pCmd -> sMatchStack = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "stackmatch", NULL) ; pCmd -> sStackName2 = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "stackname2", NULL) ; pCmd -> sPushStack2 = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "push2", NULL) ; pCmd -> sPopStack2 = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "pop2", NULL) ; pCmd -> bRemoveNode = GetHashValueInt (aTHX_ pHash, "removenode", 0) ; pCmd -> sMayJump = GetHashValueStrDup (aTHX_ r -> pThread -> pMainPool, pHash, "mayjump", NULL) ; pCmd -> bPerlCodeRemove = GetHashValueInt (aTHX_ pHash, "perlcoderemove", 0) ; pCmd -> bCompileChilds = GetHashValueInt (aTHX_ pHash, "compilechilds", 1) ; pCmd -> nSwitchCodeType = GetHashValueInt (aTHX_ pHash, "switchcodetype", 0) ; pCmd -> bCallReturn = GetHashValueInt (aTHX_ pHash, "callreturn", 0) ; pCmd -> nNodeType = nNodeType == ntypStartEndTag?ntypStartTag:nNodeType ; pCmd -> pNext = NULL ; pInfo -> pEmbperlCmds[nNodeName].bRemoveNode |= pCmd -> bRemoveNode ; /* pInfo -> pEmbperlCmds[nNodeName].bPerlCodeRemove |= pCmd -> bPerlCodeRemove ; */ if (pCmd -> nSwitchCodeType) pInfo -> pEmbperlCmds[nNodeName].nSwitchCodeType = pCmd -> nSwitchCodeType ; if (pCmd -> sMayJump && !pInfo -> pEmbperlCmds[nNodeName].sMayJump) pInfo -> pEmbperlCmds[nNodeName].sMayJump = pCmd -> sMayJump ; if (r -> Component.Config.bDebug & dbgBuildToken) lprintf (r -> pApp, "[%d]EPCOMP: InitItem %s (#%d) perlcode=%s (num=%d) perlcodeend=%s compilechilds=%d removenode=%d nodetype=%d\n", r -> pThread -> nPid, Ndx2String(nNodeName), nNodeName, pCmd -> sPerlCode?pCmd -> sPerlCode[0]:"", pCmd -> numPerlCode, pCmd -> sPerlCodeEnd?pCmd -> sPerlCodeEnd:"<undef>", pCmd -> bCompileChilds, pCmd -> bRemoveNode, pCmd -> nNodeType) ; return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* strstrn */ /* */ /* find substring of length n */ /* */ /* ------------------------------------------------------------------------ */ static const char * strstrn (const char * s1, const char * s2, int l) { while (*s1) { if ((s1 = strchr (s1, *s2)) == NULL) return NULL ; if (strncmp (s1, s2, l) == 0) return s1 ; s1++ ; } return NULL ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileAddValue */ /* */ /* Add value to perl code */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileAddValue (/*in*/ tReq * r, /*in*/ const char * sText, const char * p, const char * q, const char * eq, char op, char out, /*i/o*/ char * * ppCode ) { const char * or ; const char * e ; if (sText) { int l = strlen (sText) ; if (out == 3) { out = 2 ; while (isspace (*sText)) sText++, l-- ; while (l > 0 && isspace (sText[l-1])) l-- ; } if (op == '=' && eq) { eq++ ; do { or = strchr (eq + 1, '|') ; e = or?or:q ; if (strnicmp (sText, eq, e - eq) == 0) break ; if (or == NULL) return 0 ; eq = or + 1 ; } while (or) ; } else if (op == '~' && eq) { eq++ ; do { char * f ; or = strchr (eq + 1, '|') ; e = or?or:q ; if ((f = (char *)strstrn (sText, eq, e - eq))) if (!isalnum (f[e - eq]) && f[e - eq] != '_') break ; if (or == NULL) return 0 ; eq = or + 1 ; } while (or) ; } else if (op == '!' && sText) { return 0 ; } if (out) { if (out == 2) { const char * s = sText ; StringAdd (r -> pApp, ppCode, "'", 1) ; while (*s && l--) { if (*s == '\'') { if (sText < s) StringAdd (r -> pApp, ppCode, sText, s - sText) ; StringAdd (r -> pApp, ppCode, "\\'", 2) ; sText = s + 1 ; } else if (*s == '\\') { if (sText < s) StringAdd (r -> pApp, ppCode, sText, s - sText) ; StringAdd (r -> pApp, ppCode, "\\\\", 2) ; sText = s + 1 ; } s++ ; } if (sText < s) StringAdd (r -> pApp, ppCode, sText, s - sText) ; StringAdd (r -> pApp, ppCode, "'", 1) ; } else if (out) StringAdd (r -> pApp, ppCode, sText, 0) ; } } else { if (op != '!' && op != 0) return 0 ; /* if (out == 2) StringAdd (r -> pApp, ppCode, "''", 2) ; else */ if (out) StringAdd (r -> pApp, ppCode, "undef", 5) ; } return 1 ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompilePushStack */ /* */ /* Push valuie on named stack */ /* */ /* ------------------------------------------------------------------------ */ static void embperl_CompilePushStack (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, const char * sStackName, const char * sStackValue) { epTHX_ SV ** ppSV ; SV * pSV ; AV * pAV ; ppSV = hv_fetch((HV *)(pDomTree -> pSV), (char *)sStackName, strlen (sStackName), 1) ; if (ppSV == NULL) return ; if (*ppSV == NULL || !SvROK (*ppSV)) { if (*ppSV) SvREFCNT_dec (*ppSV) ; *ppSV = newRV_noinc ((SV *)(pAV = newAV ())) ; } else pAV = (AV *)SvRV (*ppSV) ; pSV = newSVpv ((char *)sStackValue, strlen (sStackValue)) ; SvUPGRADE (pSV, SVt_PVIV) ; SvIVX (pSV) = 0 ; av_push (pAV, pSV) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompilePopStack */ /* */ /* pop value from named stack */ /* */ /* ------------------------------------------------------------------------ */ static void embperl_CompilePopStack (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, const char * sStackName) { epTHX_ SV ** ppSV ; SV * pSV ; ppSV = hv_fetch((HV *)(pDomTree -> pSV), (char *)sStackName, strlen (sStackName), 0) ; if (ppSV == NULL || *ppSV == NULL || !SvROK (*ppSV)) return ; pSV = av_pop ((AV *)SvRV (*ppSV)) ; SvREFCNT_dec (pSV) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileMatchStack */ /* */ /* check if top of stack value matches given value */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileMatchStack (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, tNodeData * pNode, const char * sStackName, const char * sStackValue) { epTHX_ SV ** ppSV ; SV * pSV ; STRLEN l ; char * s ; ppSV = hv_fetch((HV *)(pDomTree -> pSV), (char *)sStackName, strlen (sStackName), 0) ; if (ppSV == NULL || *ppSV == NULL || !SvROK (*ppSV)) { strcpy (r -> errdat1, "CompileMatchStack") ; strncat (r -> errdat1, (char *)sStackName, sizeof (r -> errdat1) - 20) ; return rcHashError ; } pSV = av_pop ((AV *)SvRV (*ppSV)) ; s = SvPV (pSV, l) ; if (strcmp (s, sStackValue) == 0) { SvREFCNT_dec (pSV) ; return ok ; } strncpy (r -> errdat1, Node_selfNodeName (pNode), sizeof (r -> errdat1)) ; sprintf (r -> errdat2, "'%s', starttag should be '%s' or there is a 'end%s' missing", s, sStackValue, s) ; r -> Component.pCurrPos = NULL ; r -> Component.nSourceline = pNode -> nLinenumber ; SvREFCNT_dec (pSV) ; return rcTagMismatch ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileAddStack */ /* */ /* Add value of child node to perl code */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileAddStack (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, const char * p, const char * q, char op, char out, char str, /*i/o*/ char * * ppCode ) { epTHX_ const char * eq = strchr (p, ':') ; const char * e = eq && eq < q?eq:q; STRLEN l ; const char * sText = NULL ; SV ** ppSV ; AV * pAV ; ppSV = hv_fetch((HV *)(pDomTree -> pSV), (char *)p, e - p, 0) ; if (ppSV == NULL || *ppSV == NULL || !SvROK (*ppSV)) return op == '!'?1:0 ; pAV = (AV *)SvRV (*ppSV) ; if (SvTYPE (pAV) != SVt_PVAV) return op == '!'?1:0 ; ppSV = av_fetch (pAV, av_len (pAV), 0) ; if (ppSV == NULL || *ppSV == NULL) return op == '!'?1:0 ; if (str) { sText = SvPV (*ppSV, l) ; (SvIVX (*ppSV))++ ; } else sText = SvIVX (*ppSV)?"1":NULL ; return embperl_CompileAddValue (r, sText, p, q, eq, op, out, ppCode) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileAddChildNode */ /* */ /* Add value of child node to perl code */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileAddChildNode (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, const char * p, const char * q, char op, char out, /*i/o*/ char * * ppCode ) { const char * eq = strchr (p, ':') ; int nChildNo = atoi (p) ; struct tNodeData * pChildNode = Node_selfNthChild (r -> pApp, pDomTree, pNode, 0, nChildNo) ; const char * sText = NULL ; if (pChildNode) sText = Node_selfNodeName(pChildNode) ; return embperl_CompileAddValue (r, sText, p, q, eq, op, out, ppCode) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileAddSiblingNode */ /* */ /* Add value of sibling node to perl code */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileAddSiblingNode (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, const char * p, const char * q, char op, char out, /*i/o*/ char * * ppCode ) { const char * eq = strchr (p, ':') ; int nChildNo = atoi (p) ; struct tNodeData * pChildNode ; const char * sText = NULL ; if (nChildNo == 0) pChildNode = pNode ; else if (nChildNo > 0) { nChildNo-- ; pChildNode = Node_selfNextSibling (r -> pApp, pDomTree, pNode, 0) ; while (pChildNode && nChildNo-- > 0) pChildNode = Node_selfNextSibling (r -> pApp, pDomTree, pChildNode, 0) ; } else { nChildNo++ ; pChildNode = Node_selfPreviousSibling (r -> pApp, pDomTree, pNode, 0) ; while (pChildNode && nChildNo++ < 0) pChildNode = Node_selfPreviousSibling (r -> pApp, pDomTree, pChildNode, 0) ; } if (pChildNode) sText = Node_selfNodeName(pChildNode) ; return embperl_CompileAddValue (r, sText, p, q, eq, op, out, ppCode) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileAddAttribut */ /* */ /* Add value of child node to perl code */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileAddAttribut (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, const char * p, const char * q, char op, char out, /*i/o*/ char * * ppCode ) { const char * eq = strchr (p, ':') ; const char * e = eq && eq < q?eq:q; tAttrData * pChildNode = Element_selfGetAttribut (r -> pApp, pDomTree, pNode, p, e - p) ; const char * sText = NULL ; char buf [128] ; if (pChildNode) { if (pChildNode -> bFlags & aflgAttrChilds) { sprintf (buf, "XML::Embperl::DOM::Attr::iValue ($_ep_DomTree,%ld)", pChildNode -> xNdx) ; sText = buf ; if (out == 2) out = 1 ; } else { sText = Ndx2String (pChildNode -> xValue) ; } } return embperl_CompileAddValue (r, sText, p, q, eq, op, out, ppCode) ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileToPerlCode */ /* */ /* Compile one command inside a node */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileToPerlCode (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, /*in*/ const char * sPerlCode, /*out*/ char * * ppCode ) { const char * p ; const char * q ; int valid = 1 ; tNode xCurrNode = 0 ; StringNew (r -> pApp, ppCode, 512) ; if (sPerlCode) { p = strchr (sPerlCode, '%') ; while (p) { int n = p - sPerlCode ; if (n) StringAdd (r -> pApp, ppCode, sPerlCode, n) ; q = strchr (p+1, '%') ; if (q) { char type ; char op ; char out = 1 ; p++ ; type = *p ; p++ ; op = *p ; if (op != '=' && op != '*' && op != '!' && op != '~') op = 0 ; else p++ ; if (*p == '-') out = 0, p++ ; else if (*p == '\'') out = 2, p++ ; else if (*p == '"') out = 3, p++ ; if (type == '#') { if (!embperl_CompileAddChildNode (r, pDomTree, pNode ,p, q, op, out, ppCode)) { valid = 0 ; break ; } } else if (type == '>') { if (!embperl_CompileAddSiblingNode (r, pDomTree, pNode ,p, q, op, out, ppCode)) { valid = 0 ; break ; } } else if (type == '&') { if (!embperl_CompileAddAttribut (r, pDomTree, pNode ,p, q, op, out, ppCode)) { valid = 0 ; break ; } } else if (type == '^') { if (!embperl_CompileAddStack (r, pDomTree, p, q, op, out, 1, ppCode)) { valid = 0 ; break ; } } else if (type == '?') { if (!embperl_CompileAddStack (r, pDomTree, p, q, op, out, 0, ppCode)) { valid = 0 ; break ; } } else if (type == '%') { StringAdd (r -> pApp, ppCode, "%", 1) ; } else if (type == '$') { if (*p == 'n') { char s [20] ; int l = sprintf (s, "$_ep_DomTree,%ld", pNode -> xNdx) ; StringAdd (r -> pApp, ppCode, s, l) ; } else if (*p == 't') { StringAdd (r -> pApp, ppCode, "$_ep_DomTree", 0) ; } else if (*p == 'x') { char s [20] ; int l = sprintf (s, "%ld", pNode -> xNdx) ; StringAdd (r -> pApp, ppCode, s, l) ; } else if (*p == 'l') { char s [20] ; int l = sprintf (s, "%ld", pDomTree -> xLastNode) ; StringAdd (r -> pApp, ppCode, s, l) ; } else if (*p == 'c') { char s [20] ; if (pDomTree -> xLastNode != pDomTree -> xCurrNode) { int l = sprintf (s, "$_ep_node=%ld;", pDomTree -> xLastNode) ; StringAdd (r -> pApp, ppCode, s, l) ; xCurrNode = pDomTree -> xLastNode ; } } else if (*p == 'q') { char s [20] ; int l = sprintf (s, "%hd", pDomTree -> xNdx) ; StringAdd (r -> pApp, ppCode, s, l) ; } else if (*p == 'p') { char s [20] ; int l = sprintf (s, "%u", ArrayGetSize (r -> pApp, pDomTree -> pCheckpoints)) ; StringAdd (r -> pApp, ppCode, s, l) ; } else if (*p == 'k') { char s [40] ; int l ; tIndex nCheckpointArrayOffset = ArrayAdd (r -> pApp, &pDomTree -> pCheckpoints, 1) ; pDomTree -> pCheckpoints[nCheckpointArrayOffset].xNode = pNode -> xNdx ; l = sprintf (s, " _ep_cp(%ld) ;\n", nCheckpointArrayOffset) ; StringAdd (r -> pApp, ppCode, s, l) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Checkpoint\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } } sPerlCode = q + 1 ; p = strchr (sPerlCode, '%') ; } else { sPerlCode = p ; p = NULL ; } } if (valid) { StringAdd (r -> pApp, ppCode, sPerlCode, 0) ; if (xCurrNode) pDomTree -> xCurrNode = xCurrNode ; } } return valid ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileCleanupSpaces */ /* */ /* remove any following spaces */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileCleanupSpaces (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, /*i/o*/ tEmbperlCmd * pCmd) { if ((pCmd -> bRemoveNode & 6) && (r -> Component.Config.bOptions & optKeepSpaces) == 0) { tNodeData * pNextNode = Node_selfFirstChild (r -> pApp, pDomTree, pNode, 0) ; if ((pCmd -> bRemoveNode & 1) || !pCmd -> bCompileChilds || pNextNode == NULL || (pNextNode -> nType != ntypText && pNextNode -> nType != ntypCDATA)) pNextNode = Node_selfNextSibling (r -> pApp, pDomTree, pNode, 0) ; if (pNextNode) { const char * sText = Node_selfNodeName (pNextNode) ; const char * p = sText ; while (*p && isspace (*p)) p++; if (p > sText && (pCmd -> bRemoveNode & 4)) p-- ; if (p > sText) { /* remove spaces */ if (*p) Node_replaceChildWithCDATA(r -> pApp, pDomTree, pNextNode -> xNdx, 0, p, strlen (p), -1, 0) ; else Node_selfRemoveChild(r -> pApp, pDomTree, -1, pNextNode) ; } } } return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileCmd */ /* */ /* Compile one cmd of one node */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileCmd (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, /*in*/ tEmbperlCmd * pCmd, /*out*/ int * nStartCodeOffset) { epTHX_ char * pCode = NULL ; char * pCTCode = NULL ; char * sSourcefile ; int nSourcefile ; int i ; SV * args[4] ; int nCodeLen = 0 ; int found = 0 ; char *use_utf8 = "" ; if (strcmp (r -> Component.Config.sInputCharset, "utf8") == 0) use_utf8 = "use utf8;" ; r -> Component.pCodeSV = NULL ; Ndx2StringLen (pDomTree -> xFilename, sSourcefile, nSourcefile) ; if (pCmd -> nNodeType != pNode -> nType) return ok ; for (i = 0; i < pCmd -> numPerlCode; i++) if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sPerlCode[i], &pCode)) { found = 1 ; break ; } if (found && pCode) { nCodeLen = ArrayGetSize (r -> pApp, pCode) ; if (nCodeLen) { char buf [32] ; if (pNode -> nLinenumber && pNode -> nLinenumber != pDomTree -> nLastLinenumber ) { int l2 = sprintf (buf, "#line %d \"", pDomTree -> nLastLinenumber = pNode -> nLinenumber) ; StringAdd (r -> pApp, r -> Component.pProg, buf, l2) ; StringAdd (r -> pApp, r -> Component.pProg, sSourcefile, nSourcefile) ; StringAdd (r -> pApp, r -> Component.pProg, "\"\n", 2) ; } if (pCmd -> bPerlCodeRemove) *nStartCodeOffset = StringAdd (r -> pApp, r -> Component.pProg, " ", 1) ; } else { StringFree (r -> pApp, &pCode) ; pCode = NULL ; } } else { StringFree (r -> pApp, &pCode) ; pCode = NULL ; } for (i = 0; i < pCmd -> numCompileTimePerlCode; i++) { if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sCompileTimePerlCode[i], &pCTCode)) { SV * pSV ; int rc ; if (pCTCode) { int l = ArrayGetSize (r -> pApp, pCTCode) ; int i = l ; char *p = pCTCode ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d CompileTimeCode: %*.*s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCTCode) ; if (p[0] == '#' && p[1] == '!' && p[2] == '-') { p[0] = ' ' ; p[1] = ' ' ; p[2] = ' ' ; while (i--) { /* keep everything on one line, to make linenumbers correct */ if (*p == '\r' || *p == '\n') *p = ' ' ; p++ ; } } pSV = newSVpvf("package %s ; %s\n#line %d \"%s\"\n%*.*s", r -> Component.sEvalPackage, use_utf8, pNode -> nLinenumber, sSourcefile, l,l, pCTCode) ; newSVpvf2(pSV) ; args[0] = r -> _perlsv ; if (pCode) { r -> Component.pCodeSV = newSVpv (pCode, nCodeLen) ; } else r -> Component.pCodeSV = &sv_undef ; SvTAINTED_off (pSV) ; if ((rc = EvalDirect (r, pSV, 1, args)) != ok) LogError (r, rc) ; SvREFCNT_dec(pSV); } break ; } } if (r -> Component.pCodeSV && SvOK(r -> Component.pCodeSV)) { STRLEN l ; char * p = SvPV (r -> Component.pCodeSV, l) ; StringAdd (r -> pApp, r -> Component.pProg, p, l ) ; StringAdd (r -> pApp, r -> Component.pProg, "\n", 1) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Code: %s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, p) ; } else if (pCode) { StringAdd (r -> pApp, r -> Component.pProg, pCode, nCodeLen ) ; StringAdd (r -> pApp, r -> Component.pProg, "\n", 1) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Code: %*.*s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, nCodeLen, nCodeLen, pCode) ; } StringFree (r -> pApp, &pCode) ; StringFree (r -> pApp, &pCTCode) ; if (r -> Component.pCodeSV) { SvREFCNT_dec(r -> Component.pCodeSV); r -> Component.pCodeSV = NULL ; } return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompilePostProcess */ /* */ /* Do some postprocessing after compiling */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompilePostProcess (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, /*in*/ tEmbperlCmd * pCmd, /*in*/ int nCheckpointCodeOffset, /*in*/ int nCheckpointArrayOffset, /*i/o*/ int * bCheckpointPending) { int rc ; char * sStackValue = NULL ; embperl_CompileCleanupSpaces (r, pDomTree, pNode, pCmd) ; if (pCmd -> sMayJump) if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sMayJump, &sStackValue)) { if (*bCheckpointPending <= 0) *bCheckpointPending = -1 ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Set Checkpoint pending\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } if (pCmd -> bRemoveNode & 1) pNode -> bFlags = 0 ; else if (pCmd -> bRemoveNode & 8) pNode -> bFlags |= nflgIgnore ; if (pCmd -> bRemoveNode & 16) { tNodeData * pChild ; while ((pChild = Node_selfFirstChild (r -> pApp, pDomTree, pNode, 0))) { Node_selfRemoveChild (r -> pApp, pDomTree, pNode -> xNdx, pChild) ; } } else if (pCmd -> bRemoveNode & 32) { tNodeData * pChild = Node_selfFirstChild (r -> pApp, pDomTree, pNode, 0) ; while (pChild) { pChild -> bFlags |= nflgIgnore ; pChild = Node_selfNextSibling (r -> pApp, pDomTree, pChild, 0) ; } } if (nCheckpointCodeOffset && (pNode -> bFlags == 0 || (pNode -> bFlags & nflgIgnore))) { (*r -> Component.pProg)[nCheckpointCodeOffset] = '#' ; nCheckpointArrayOffset = ArraySub (r -> pApp, &pDomTree -> pCheckpoints, 1) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Remove Checkpoint\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; nCheckpointCodeOffset = 0 ; if (*bCheckpointPending <= 0) *bCheckpointPending = -1 ; /* set checkpoint on next possibility */ } if (*bCheckpointPending < 0 && (pNode -> bFlags & nflgIgnore)) { int l ; char buf [80] ; nCheckpointArrayOffset = ArrayAdd (r -> pApp, &pDomTree -> pCheckpoints, 1) ; pDomTree -> pCheckpoints[nCheckpointArrayOffset].xNode = pNode -> xNdx ; *bCheckpointPending = 0 ; l = sprintf (buf, " _ep_cp(%d) ;\n", nCheckpointArrayOffset) ; nCheckpointCodeOffset = StringAdd (r -> pApp, r -> Component.pProg, buf, l) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Checkpoint\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } if (pCmd -> sPopStack) embperl_CompilePopStack (r, pDomTree, pCmd -> sPopStack) ; if (pCmd -> sPopStack2) embperl_CompilePopStack (r, pDomTree, pCmd -> sPopStack2) ; if (pCmd -> sStackName) { if (pCmd -> sMatchStack && pNode -> nType != ntypStartTag && pNode -> nType != ntypDocument && pNode -> nType != ntypDocumentFraq) { if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sMatchStack, &sStackValue)) if ((rc = embperl_CompileMatchStack (r, pDomTree, pNode, pCmd -> sStackName, sStackValue)) != ok) { StringFree (r -> pApp, &sStackValue) ; return rc ; } } if (pCmd -> sPushStack) { if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sPushStack, &sStackValue)) embperl_CompilePushStack (r, pDomTree, pCmd -> sStackName, sStackValue) ; } } if (pCmd -> sStackName2 && pCmd -> sPushStack2) { if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sPushStack2, &sStackValue)) { embperl_CompilePushStack (r, pDomTree, pCmd -> sStackName2, sStackValue) ; } } StringFree (r -> pApp, &sStackValue) ; return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileCmdEnd */ /* */ /* Compile the end of the node */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileCmdEnd (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNodeData * pNode, /*in*/ tEmbperlCmd * pCmd, /*in*/ int nStartCodeOffset, /*i/o*/ int * bCheckpointPending) { epTHX_ int rc ; char * sStackValue = NULL ; char * pCode = NULL ; char * pCTCode = NULL ; SV * args[4] ; STRLEN nCodeLen = 0 ; char *use_utf8 = "" ; if (strcmp (r -> Component.Config.sInputCharset, "utf8") == 0) use_utf8 = "use utf8;" ; if (pCmd -> nNodeType != pNode -> nType) return ok ; if (pCmd) { if (pCmd -> sPerlCodeEnd && embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sPerlCodeEnd, &pCode)) nCodeLen = ArrayGetSize (r -> pApp, pCode) ; if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sCompileTimePerlCodeEnd, &pCTCode)) { SV * pSV ; int rc ; if (pCTCode && *pCTCode) { int l = ArrayGetSize (r -> pApp, pCTCode) ; char * sSourcefile ; int nSourcefile ; int i = l ; char * p = pCTCode ; Ndx2StringLen (pDomTree -> xFilename, sSourcefile, nSourcefile) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d CompileTimeCodeEnd: %*.*s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCTCode) ; if (p[0] == '#' && p[1] == '!' && p[2] == '-') { p[0] = ' ' ; p[1] = ' ' ; p[2] = ' ' ; while (i--) { /* keep everything on one line, to make linenumbers correct */ if (*p == '\r' || *p == '\n') *p = ' ' ; p++ ; } } pSV = newSVpvf("package %s ; %s\n#line %d \"%s\"\n%*.*s", r -> Component.sEvalPackage, use_utf8, pNode -> nLinenumber, sSourcefile, l,l, pCTCode) ; newSVpvf2(pSV) ; args[0] = r -> _perlsv ; if (pCode) { r -> Component.pCodeSV = newSVpv (pCode, nCodeLen) ; } else r -> Component.pCodeSV = &sv_undef ; if ((rc = EvalDirect (r, pSV, 1, args)) != ok) LogError (r, rc) ; SvREFCNT_dec(pSV); } } if (r -> Component.pCodeSV) { if (SvOK (r -> Component.pCodeSV)) { char * p = SvPV (r -> Component.pCodeSV, nCodeLen) ; if (nCodeLen) { StringAdd (r -> pApp, r -> Component.pProg, p, nCodeLen ) ; StringAdd (r -> pApp, r -> Component.pProg, "\n", 1) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d CodeEnd: %s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, p) ; } } } else if (pCode && nCodeLen) { StringAdd (r -> pApp, r -> Component.pProg, pCode, nCodeLen ) ; StringAdd (r -> pApp, r -> Component.pProg, "\n", 1) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d CodeEnd: %*.*s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, nCodeLen, nCodeLen, pCode) ; } if (nCodeLen == 0) { if (pCmd -> bPerlCodeRemove && nStartCodeOffset) { (*r -> Component.pProg)[nStartCodeOffset] = '#' ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Remove Codeblock\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } } if (pCmd -> sPerlCodeEnd && pCmd -> sMayJump) if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sMayJump, &sStackValue)) { if (*bCheckpointPending <= 0) *bCheckpointPending = -1 ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Set Checkpoint pending\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } if (pCmd -> sStackName && (pNode -> nType == ntypStartTag || pNode -> nType == ntypDocument || pNode -> nType == ntypDocumentFraq)) { if (pCmd -> sMatchStack) { if (embperl_CompileToPerlCode (r, pDomTree, pNode, pCmd -> sMatchStack, &sStackValue)) { if ((rc = embperl_CompileMatchStack (r, pDomTree, pNode, pCmd -> sStackName, sStackValue)) != ok) { StringFree (r -> pApp, &pCode) ; StringFree (r -> pApp, &pCTCode) ; StringFree (r -> pApp, &sStackValue) ; return rc ; } } } else if (pCmd -> sPushStack && pCmd -> sPerlCodeEnd) embperl_CompilePopStack (r, pDomTree, pCmd -> sStackName) ; } if (pCmd -> sStackName2 && pCmd -> sPushStack2 && pCmd -> sPerlCodeEnd) embperl_CompilePopStack (r, pDomTree, pCmd -> sStackName2) ; if (pCmd -> nSwitchCodeType == 1) { r -> Component.pProg = &r -> Component.pProgRun ; if (*bCheckpointPending <= 0) *bCheckpointPending = -1 ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Set Checkpoint pending (switch to ProgRun)\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } } StringFree (r -> pApp, &pCode) ; StringFree (r -> pApp, &pCTCode) ; if (r -> Component.pCodeSV) { SvREFCNT_dec(r -> Component.pCodeSV); r -> Component.pCodeSV = NULL ; } StringFree (r -> pApp, &sStackValue) ; return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileNode */ /* */ /* Compile one node and his children */ /* */ /* ------------------------------------------------------------------------ */ int embperl_CompileNode (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree, /*in*/ tNode xNode, /*i/o*/ int * bCheckpointPending) { int rc ; tNode xChildNode ; tStringIndex nNdx ; tEmbperlCmd * pCmd ; tEmbperlCmd * pCmdHead ; tEmbperlCmd * pCmdLast ; tEmbperlCmd * pCmdNext ; tEmbperlCmd * pCmdIter ; tNodeData * pNode = Node_self (pDomTree, xNode) ; tAttrData * pAttr ; int nAttr = 0 ; int nStartCodeOffset = 0 ; int nCheckpointCodeOffset = 0 ; int nCheckpointArrayOffset = 0 ; tEmbperlCompilerInfo * pInfo = (tEmbperlCompilerInfo *)(*(void * *)r -> Component.pTokenTable) ; tIndex xDomTree = pDomTree -> xNdx ; pCmd = NULL ; nNdx = Node_selfNodeNameNdx (pNode) ; if (nNdx <= pInfo -> nMaxEmbperlCmd) { pCmd = pCmdHead = &(pInfo -> pEmbperlCmds[nNdx]) ; pCmdLast = NULL ; /* ??if (pCmd -> nNodeType != pNode -> nType) */ /* pCmd = NULL ; */ } else pCmd = pCmdHead = pCmdLast = NULL ; if (r -> Component.Config.bDebug & dbgCompile) { char buf[20] ; lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d -------> parent=%d node=%d type=%d text=%s (#%d,%s) %s\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber, Node_parentNode (r -> pApp, pDomTree, pNode -> xNdx, 0), pNode -> xNdx, pNode -> nType, Node_selfNodeName(pNode), nNdx, pCmd?"compile":"-", (pCmd && pCmd -> bRemoveNode)?(sprintf (buf, "removenode=%d", pCmd -> bRemoveNode), buf):"") ; } if (pCmd == NULL || (pCmd -> bRemoveNode & 1) == 0) pDomTree -> xLastNode = xNode ; /* if (*bCheckpointPending && (pNode -> nType == ntypText || pNode -> nType == ntypCDATA) && pNode -> bFlags && (pNode -> bFlags & nflgIgnore) == 0) */ /* if (*bCheckpointPending && pNode -> bFlags && (pNode -> bFlags & nflgIgnore) == 0) */ if (*bCheckpointPending < 0 && !(pCmd && pCmd -> nSwitchCodeType == 2) && pNode -> bFlags && (pNode -> bFlags & nflgIgnore) == 0) { int l ; char buf [80] ; nCheckpointArrayOffset = ArrayAdd (r -> pApp, &pDomTree -> pCheckpoints, 1) ; pDomTree -> pCheckpoints[nCheckpointArrayOffset].xNode = xNode ; *bCheckpointPending = 0 ; l = sprintf (buf, " _ep_cp(%d) ;\n", nCheckpointArrayOffset) ; nCheckpointCodeOffset = StringAdd (r -> pApp, r -> Component.pProg, buf, l) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d L%d Checkpoint\n", r -> pThread -> nPid, pNode -> xNdx, pNode -> nLinenumber) ; } if (pCmd && pCmd -> nSwitchCodeType == 2) { r -> Component.pProg = &r -> Component.pProgDef ; nCheckpointArrayOffset = 0 ; nCheckpointCodeOffset = 0 ; } if (pCmd == NULL || (pCmd -> bRemoveNode & 8) == 0 || (pCmd -> bRemoveNode & 64)) { /* calculate attributes before tag, but not when tag should be ignored in output stream */ int bSaveCP = *bCheckpointPending ; if (pCmd && (pCmd -> bRemoveNode & 64)) *bCheckpointPending = 1 ; while ((pAttr = Element_selfGetNthAttribut (r -> pApp, pDomTree, pNode, nAttr++))) { if (pAttr -> bFlags & aflgAttrChilds) { tNodeData * pChild = Node_selfFirstChild (r -> pApp, pDomTree, (tNodeData *)pAttr, 0) ; tNodeData * pNext ; while (pChild) { embperl_CompileNode (r, pDomTree, pChild -> xNdx, bCheckpointPending) ; pDomTree = DomTree_self (xDomTree) ; /* addr may have changed */ pNext = Node_selfNextSibling (r -> pApp, pDomTree, pChild, 0) ; if (pChild -> bFlags == 0) Node_selfRemoveChild(r -> pApp, pDomTree, -1, pChild) ; pChild = pNext ; } } } if (pCmd && (pCmd -> bRemoveNode & 64)) *bCheckpointPending = bSaveCP ; } while (pCmd) { if ((rc = embperl_CompileCmd (r, pDomTree, pNode, pCmd, &nStartCodeOffset)) != ok) return rc ; pDomTree = DomTree_self (xDomTree) ; /* addr may have changed */ pCmdLast = pCmd ; pCmd = pCmd -> pNext ; } pCmd = pCmdLast ; if (pCmd) if ((rc = embperl_CompilePostProcess (r, pDomTree, pNode, pCmd, nCheckpointCodeOffset, nCheckpointArrayOffset, bCheckpointPending)) != ok) return rc ; if (pCmd == NULL || pCmd -> bCompileChilds) { tNodeData * pChildNode ; xChildNode = pNode -> bFlags?Node_firstChild (r -> pApp, pDomTree, xNode, 0):0 ; while (xChildNode) { if ((rc = embperl_CompileNode (r, pDomTree, xChildNode, bCheckpointPending)) != ok) return rc ; pDomTree = DomTree_self (xDomTree) ; /* addr may have changed */ pChildNode = Node_self (pDomTree, xChildNode) ; xChildNode = Node_nextSibling (r -> pApp, pDomTree, xChildNode, 0) ; if (pChildNode -> bFlags == 0) Node_selfRemoveChild(r -> pApp, pDomTree, -1, pChildNode) ; } } while (pCmd) { if ((rc = embperl_CompileCmdEnd (r, pDomTree, pNode, pCmd, nStartCodeOffset, bCheckpointPending)) != ok) return rc ; pCmdIter = pCmdHead ; pCmdNext = NULL ; while (pCmdIter && pCmdIter != pCmd) { pCmdNext = pCmdIter ; pCmdIter = pCmdIter -> pNext ; } pCmd = pCmdNext ; } if (pCmdHead && pCmdHead -> nSwitchCodeType == 2) { r -> Component.pProg = &r -> Component.pProgRun ; nCheckpointArrayOffset = 0 ; nCheckpointCodeOffset = 0 ; } return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_CompileDomTree */ /* */ /* Compile root node and his children */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_CompileDomTree (/*in*/ tReq * r, /*in*/ tDomTree * pDomTree) { int rc ; int bCheckpointPending = 0 ; tIndex xDomTree = pDomTree -> xNdx ; pDomTree -> xCurrNode = 0 ; if ((rc = embperl_CompileNode (r, pDomTree, pDomTree -> xDocument, &bCheckpointPending)) != ok) return rc ; pDomTree = DomTree_self (xDomTree) ; /* addr may have changed */ if (bCheckpointPending) { int l ; char buf [80] ; int nCheckpointArrayOffset = ArrayAdd (r -> pApp, &pDomTree -> pCheckpoints, 1) ; pDomTree -> pCheckpoints[nCheckpointArrayOffset].xNode = -1 ; l = sprintf (buf, " _ep_cp(%d) ;\n", nCheckpointArrayOffset) ; StringAdd (r -> pApp, r -> Component.pProg, buf, l) ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: #%d Checkpoint\n", r -> pThread -> nPid, -1) ; } return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_Compile */ /* */ /* Compile the whole document */ /* */ /* ------------------------------------------------------------------------ */ int embperl_Compile (/*in*/ tReq * r, /*in*/ tIndex xDomTree, /*out*/ tIndex * pxResultDomTree, /*out*/ SV * * pProg) { epTHX_ int rc ; tDomTree * pDomTree = DomTree_self (*pxResultDomTree = xDomTree) ; char * sSourcefile = DomTree_selfFilename (pDomTree) ; clock_t cl1 = clock () ; clock_t cl2 ; clock_t cl3 ; clock_t cl4 ; STRLEN l ; SV * pSV ; SV * args[2] ; /* int nStep = r -> Buf.pFile -> nFilesize / 4 ; if (nStep < 1024) nStep = 1024 ; else if (nStep > 4096) nStep = 4096 ; */ int nStep = 8192 ; char *use_utf8 = "" ; if (strcmp (r -> Component.Config.sInputCharset, "utf8") == 0) use_utf8 = "use utf8;" ; if (r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: Start compiling %s DomTree = %d\n", r -> pThread -> nPid, sSourcefile, xDomTree) ; if (r -> Component.Config.bOptions & optChdirToSource) ChdirToSource (r, sSourcefile) ; r -> Component.nPhase = phCompile ; r -> Component.pProgRun = NULL ; r -> Component.pProgDef = NULL ; StringNew (r -> pApp, &r -> Component.pProgRun, nStep ) ; StringNew (r -> pApp, &r -> Component.pProgDef, nStep ) ; r -> Component.pProg = &r -> Component.pProgRun ; pDomTree -> pSV = (SV *)newHV () ; if (pDomTree -> pCheckpoints) ArraySetSize (r -> pApp, &pDomTree -> pCheckpoints, 0) ; else ArrayNew (r -> pApp, &pDomTree -> pCheckpoints, 256, sizeof (tDomTreeCheckpoint)) ; ArrayAdd (r -> pApp, &pDomTree -> pCheckpoints, 1) ; pDomTree -> pCheckpoints[0].xNode = 0 ; if ((rc = embperl_CompileDomTree (r, pDomTree)) != ok) { /* *ppSV = newSVpvf ("%s\t%s", r -> errdat1, r -> errdat2) ; SvUPGRADE (*ppSV, SVt_PVIV) ; SvIVX (*ppSV) = rc ; if (r -> Component.xCurrDomTree) { DomTree_delete(DomTree_self(r -> Component.xCurrDomTree)) ; r -> Component.xCurrDomTree = 0 ; } */ StringFree (r -> pApp, &r -> Component.pProgRun) ; StringFree (r -> pApp, &r -> Component.pProgDef) ; ArrayFree (r -> pApp, &pDomTree -> pCheckpoints) ; pDomTree -> pCheckpoints = NULL ; pDomTree = DomTree_self (xDomTree) ; DomTree_delete (r -> pApp, pDomTree) ; *pxResultDomTree = 0 ; return rc ; } pDomTree = DomTree_self (xDomTree) ; /* addr may have changed */ SvREFCNT_dec (pDomTree -> pSV) ; pDomTree -> pSV = NULL ; StringAdd (r -> pApp, &r -> Component.pProgRun, "", 1) ; StringAdd (r -> pApp, &r -> Component.pProgDef, r -> Component.Config.sTopInclude?r -> Component.Config.sTopInclude:"", 0) ; cl2 = clock () ; r -> Component.nPhase = phRunAfterCompile ; l = ArrayGetSize (r -> pApp, r -> Component.pProgDef) ; if (l > 1 && r -> Component.Config.bDebug & dbgCompile) lprintf (r -> pApp, "[%d]EPCOMP: AfterCompileTimeCode: %*.*s\n", r -> pThread -> nPid, l, l, r -> Component.pProgDef) ; if (l > 1) { pSV = newSVpvf("package %s ; %s\n%*.*s", r -> Component.sEvalPackage, use_utf8, (int)l,(int)l, r -> Component.pProgDef) ; newSVpvf2(pSV) ; args[0] = r -> _perlsv ; args[1] = pDomTree -> pDomTreeSV ; if ((rc = EvalDirect (r, pSV, 0, args)) != ok) LogError (r, rc) ; SvREFCNT_dec(pSV); } cl3 = clock () ; r -> Component.nPhase = phPerlCompile ; if (PERLDB_LINE) { /* feed source to file gv (@/%_<filename) if we are running under the debugger */ GV * pGVFile = gv_fetchfile (sSourcefile) ; AV * pDebugArray = GvAV (pGVFile) ; char * p = r -> Component.pBuf ; char * end ; I32 i = 1 ; while (*p) { end = strchr (p, '\n') ; if (end) { SV * pLine ; pLine = newSVpv (p, end - p + 1) ; SvUPGRADE (pLine, SVt_PVMG) ; av_store (pDebugArray, i++, pLine) ; p = end + 1 ; } else if (p < r -> Component.pEndPos) { SV * pLine ; pLine = newSVpv (p, r -> Component.pEndPos - p + 1) ; SvUPGRADE (pLine, SVt_PVMG) ; av_store (pDebugArray, i++, pLine) ; break ; } } if (r -> Component.Config.bDebug) lprintf (r -> pApp, "Setup source code for interactive debugger\n") ; } /* * Does not work with perl >= 5.14 */ #if PERL_VERSION < 14 UndefSub (r, r -> Component.sMainSub, r -> Component.sCurrPackage) ; #endif rc = EvalOnly (r, r -> Component.pProgRun, pProg, G_SCALAR, r -> Component.sMainSub) ; StringFree (r -> pApp, &r -> Component.pProgRun) ; StringFree (r -> pApp, &r -> Component.pProgDef) ; if (rc != ok && xDomTree) { pDomTree = DomTree_self (xDomTree) ; if (pDomTree) DomTree_delete (r -> pApp, pDomTree) ; *pxResultDomTree = 0 ; } cl4 = clock () ; #ifdef CLOCKS_PER_SEC if (r -> Component.Config.bDebug) { lprintf (r -> pApp, "[%d]PERF: Compile Start Time: %d ms \n", r -> pThread -> nPid, ((cl1 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: Compile End Time: %d ms \n", r -> pThread -> nPid, ((cl2 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: After Compile Exec End Time: %d ms \n", r -> pThread -> nPid, ((cl3 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: Perl Compile End Time: %d ms \n", r -> pThread -> nPid, ((cl4 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: Compile Time: %d ms \n", r -> pThread -> nPid, ((cl4 - cl1) * 1000 / CLOCKS_PER_SEC)) ; DomStats (r -> pApp) ; } #endif return rc ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_Executer */ /* */ /* ------------------------------------------------------------------------ */ static int embperl_Execute2 (/*in*/ tReq * r, /*in*/ tIndex xSrcDomTree, /*in*/ CV * pCV, /*in*/ tIndex * pResultDomTree) { epTHX_ int rc ; tDomTree * pCurrDomTree ; clock_t cl1 = clock () ; clock_t cl2 ; SV * pSV ; char * sSubName ; tainted = 0 ; r -> Component.xCurrDomTree = xSrcDomTree ; sSubName = r -> Component.Param.sSub ; if (sSubName && !*sSubName) sSubName = NULL ; rc = ok ; cl1 = clock () ; r -> Component.nPhase = phRun ; r -> Component.nCurrCheckpoint = 1 ; r -> Component.nCurrRepeatLevel = 0 ; r -> Component.xSourceDomTree = r -> Component.xCurrDomTree ; if (!(r -> Component.xCurrDomTree = DomTree_clone (r -> pApp, DomTree_self (xSrcDomTree), &pCurrDomTree, sSubName?1:0))) return 1 ; *pResultDomTree = r -> Component.xCurrDomTree ; /* -> is done by cache management -> av_push (r -> pDomTreeAV, pCurrDomTree -> pDomTreeSV) ; */ pCurrDomTree = DomTree_self (r -> Component.xCurrDomTree) ; ArrayNewZero (r -> pApp, &pCurrDomTree -> pCheckpointStatus, ArrayGetSize (r -> pApp, pCurrDomTree -> pCheckpoints), sizeof(tDomTreeCheckpointStatus)) ; if (pCV) { SV * args[2] ; STRLEN l ; SV * sDomTreeSV = newSVpvf ("%s::%s", r -> Component.sEvalPackage, "_ep_DomTree") ; SV * pDomTreeSV = perl_get_sv (SvPV (sDomTreeSV, l), TRUE) ; IV xOldDomTree = 0 ; newSVpvf2(sDomTreeSV) ; if (SvIOK (pDomTreeSV)) xOldDomTree = SvIVX (pDomTreeSV) ; sv_setiv (pDomTreeSV, r -> Component.xCurrDomTree) ; SvREFCNT_dec (sDomTreeSV) ; av_push (r -> pCleanupAV, newRV_inc (pDomTreeSV)) ; args[0] = r -> _perlsv ; if (sSubName) { SV * pSVName = newSVpvf ("%s::_ep_sub_%s", r -> Component.sEvalPackage, sSubName) ; newSVpvf2(pSVName) ; pCurrDomTree -> xDocument = 0 ; /* set by first checkpoint */ rc = CallStoredCV (r, r -> Component.pProgRun, (CV *)pSVName, 1, args, 0, &pSV) ; if (pSVName) SvREFCNT_dec (pSVName) ; if (pSV) SvREFCNT_dec (pSV) ; } else { rc = CallStoredCV (r, r -> Component.pProgRun, (CV *)pCV, 1, args, 0, &pSV) ; if (pSV) SvREFCNT_dec (pSV) ; } pCurrDomTree = DomTree_self (r -> Component.xCurrDomTree) ; /* relookup DomTree in case it has moved */ cl2 = clock () ; #ifdef CLOCKS_PER_SEC if (r -> Component.Config.bDebug) { lprintf (r -> pApp, "[%d]PERF: Run Start Time: %d ms \n", r -> pThread -> nPid, ((cl1 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: Run End Time: %d ms \n", r -> pThread -> nPid, ((cl2 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ; lprintf (r -> pApp, "[%d]PERF: Run Time: %d ms \n", r -> pThread -> nPid, ((cl2 - cl1) * 1000 / CLOCKS_PER_SEC)) ; DomStats (r -> pApp) ; } #endif sv_setiv (pDomTreeSV, xOldDomTree) ; } ArrayFree (r -> pApp, &pCurrDomTree -> pCheckpointStatus) ; if (rc != ok && rc != rcEvalErr) return rc ; r -> Component.nPhase = phTerm ; return ok ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_Execute */ /* */ /* ------------------------------------------------------------------------ */ int embperl_Execute (/*in*/ tReq * r, /*in*/ tIndex xSrcDomTree, /*in*/ CV * pCV, /*in*/ tIndex * pResultDomTree) { epTHX_ int rc = ok ; char * sSourcefile = r -> Component.sSourcefile ; tainted = 0 ; if (!r -> bError) { tComponent * c = &r -> Component ; GV * gv ; HV * pStash = gv_stashpv (c -> sCurrPackage, 1) ; if (r -> Component.Config.nCleanup > -1 && (r -> Component.Config.bOptions & optDisableVarCleanup) == 0) SetHashValueInt (r, r -> pCleanupPackagesHV, r -> Component.sCurrPackage, 1) ; /* --- change working directory --- */ if (r -> Component.Config.bOptions & optChdirToSource) ChdirToSource (r, sSourcefile) ; if (c -> Param.pParam) { gv = *((GV **)hv_fetch (pStash, "param", 5, 0)) ; /* gv = r -> pThread -> pParamArrayGV ; */ save_ary (gv) ; SvREFCNT_dec((SV *)GvAV(gv)) ; GvAV(gv) = (AV *)SvREFCNT_inc(c -> Param.pParam) ; } if (c -> Param.pFormHash) { gv = *((GV **)hv_fetch (pStash, "fdat", 4, 0)) ; /* gv = r -> pThread -> pFormHashGV ; */ save_hash (gv) ; SvREFCNT_dec((SV *)GvHV(gv)) ; GvHV(gv) = (HV *)SvREFCNT_inc(c -> Param.pFormHash) ; } if (c -> Param.pFormArray || c -> Param.pFormHash) { gv = *((GV **)hv_fetch (pStash, "ffld", 4, 0)) ; /* gv = r -> pThread -> pFormArrayGV ; */ save_ary (gv) ; SvREFCNT_dec((SV *)GvAV(gv)) ; if (c -> Param.pFormArray) GvAV(gv) = (AV *)SvREFCNT_inc(c -> Param.pFormArray) ; else { /* SVREFCNT_dec (pAV) is done by LEAVE, because of save_ary above (you can savely ignore dmalloc logged error) */ AV * pAV = newAV (); HE * pEntry ; char * pKey ; I32 l ; GvAV(gv) = pAV ; hv_iterinit (c -> Param.pFormHash) ; while ((pEntry = hv_iternext (c -> Param.pFormHash))) { pKey = hv_iterkey (pEntry, &l) ; av_push (pAV, newSVpv(pKey, l)) ; } } } else { } rc = embperl_Execute2 (r, xSrcDomTree, pCV, pResultDomTree) ; /* --- restore working directory --- */ if (r -> Component.sResetDir[0]) { #ifdef WIN32 _chdrive (r -> Component.nResetDrive) ; #endif chdir (r -> Component.sResetDir) ; strcpy (r -> Component.sCWD,r -> Component.sResetDir) ; r -> Component.sResetDir[0] = '\0' ; } } else *pResultDomTree = 0 ; r -> Component.nPhase = phTerm ; return rc ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_ExecuteSubStart */ /* */ /* Setup the start of a sub */ /* */ /* in pDomTreeSV SV which holds the DomTree in the current package */ /* in xDomTree Source DomTree */ /* in pSaveAV Array to save some values */ /* */ /* ------------------------------------------------------------------------ */ int embperl_ExecuteSubStart (/*in*/ tReq * r, /*in*/ SV * pDomTreeSV, /*in*/ tIndex xDomTree, /*in*/ AV * pSaveAV) { epTHX_ tIndex xOrgDomTree = -1 ; tIndex xOldDomTree ; tDomTree * pDomTree ; tDomTree * pCurrDomTree ; if (!r || !r -> Component.bReqRunning) { LogErrorParam (r?r -> pApp:NULL, rcSubCallNotRequest, "", "") ; return rcSubCallNotRequest ; } av_push (pSaveAV, newSViv (r -> Component.xCurrDomTree)) ; av_push (pSaveAV, newSViv (r -> Component.xCurrNode)) ; av_push (pSaveAV, newSViv (r -> Component.nCurrRepeatLevel)) ; av_push (pSaveAV, newSViv (r -> Component.nCurrCheckpoint)) ; av_push (pSaveAV, newSViv (r -> Component.bSubNotEmpty)) ; pDomTree = DomTree_self (xDomTree) ; xOldDomTree = r -> Component.xCurrDomTree ; if (!(r -> Component.xCurrDomTree = DomTree_clone (r -> pApp, pDomTree, &pCurrDomTree, 1))) return 0 ; ArrayNewZero (r -> pApp, &pCurrDomTree -> pCheckpointStatus, ArrayGetSize (r -> pApp, pCurrDomTree -> pCheckpoints), sizeof(tDomTreeCheckpointStatus)) ; r -> Component.nCurrCheckpoint = 1 ; r -> Component.nCurrRepeatLevel = 0 ; r -> Component.xCurrNode = 0 ; r -> Component.bSubNotEmpty = 0 ; pCurrDomTree -> xDocument = 0 ; /* set by first checkpoint */ av_push (r -> pDomTreeAV, pCurrDomTree -> pDomTreeSV) ; av_push (r -> pCleanupAV, newRV_inc (pDomTreeSV)) ; sv_setiv (pDomTreeSV, r -> Component.xCurrDomTree) ; if (r -> Component.Config.bDebug & dbgRun) lprintf (r -> pApp, "[%d]SUB: Enter from DomTree=%d into new DomTree=%d, Source DomTree=%d (org=%d)\n", r -> pThread -> nPid, xOldDomTree, r -> Component.xCurrDomTree, xDomTree, xOrgDomTree) ; return r -> Component.xCurrDomTree ; } /* ------------------------------------------------------------------------ */ /* */ /* embperl_ExecuteSubEnd */ /* */ /* End a sub */ /* */ /* in pSaveAV Array to save some values */ /* */ /* ------------------------------------------------------------------------ */ int embperl_ExecuteSubEnd (/*in*/ tReq * r, /*in*/ SV * pDomTreeSV, /*in*/ AV * pSaveAV) { epTHX_ tIndex xSubDomTree = r -> Component.xCurrDomTree ; tIndex xDocFraq ; int bSubNotEmpty = r -> Component.bSubNotEmpty ; tDomTree * pCallerDomTree ; tDomTree * pSubDomTree = DomTree_self (xSubDomTree) ; if (AvFILL (pSaveAV) < 1) return ok ; if (r -> Component.xCurrNode == 0) bSubNotEmpty = 1 ; ArrayFree (r -> pApp, &pSubDomTree -> pCheckpointStatus) ; r -> Component.xCurrDomTree = SvIV (* av_fetch (pSaveAV, 0, 0)) ; r -> Component.xCurrNode = SvIV (* av_fetch (pSaveAV, 1, 0)) ; r -> Component.nCurrRepeatLevel = (tRepeatLevel)SvIV (* av_fetch (pSaveAV, 2, 0)) ; r -> Component.nCurrCheckpoint = SvIV (* av_fetch (pSaveAV, 3, 0)) ; r -> Component.bSubNotEmpty = SvIV (* av_fetch (pSaveAV, 4, 0)) + bSubNotEmpty; sv_setiv (pDomTreeSV, r -> Component.xCurrDomTree) ; pCallerDomTree = DomTree_self (r -> Component.xCurrDomTree) ; if (bSubNotEmpty && r -> Component.xCurrNode) r -> Component.xCurrNode = xDocFraq = Node_insertAfter (r -> pApp, pSubDomTree, pSubDomTree -> xDocument, 0, pCallerDomTree, r -> Component.xCurrNode, r -> Component.nCurrRepeatLevel) ; if (r -> Component.Config.bDebug & dbgRun) lprintf (r -> pApp, "[%d]SUB: Leave from DomTree=%d back to DomTree=%d RepeatLevel=%d\n", r -> pThread -> nPid, xSubDomTree, r -> Component.xCurrDomTree, r -> Component.nCurrRepeatLevel) ; return ok ; }