/*###################################################################################
#
#   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 ;
    }