You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@locus.apache.org on 2000/05/19 15:35:31 UTC

cvs commit: embperl/Embperl Syntax.pm

richter     00/05/19 06:35:31

  Modified:    .        Tag: Embperl2 Changes.pod Embperl.pm Embperl.xs
                        ep.h epcomp.c epdom.c epdom.h epparse.c eputil.c
                        test.pl
               Embperl  Tag: Embperl2 Syntax.pm
  Log:
  Embperl 2
  
  Revision  Changes    Path
  No                   revision
  
  
  No                   revision
  
  
  1.115.2.2 +18 -1     embperl/Changes.pod
  
  Index: Changes.pod
  ===================================================================
  RCS file: /home/cvs/embperl/Changes.pod,v
  retrieving revision 1.115.2.1
  retrieving revision 1.115.2.2
  diff -u -r1.115.2.1 -r1.115.2.2
  --- Changes.pod	2000/05/03 20:57:30	1.115.2.1
  +++ Changes.pod	2000/05/19 13:35:25	1.115.2.2
  @@ -3,7 +3,24 @@
   =head1 2.0b1_dev -- That's what currently under developement
   
      - "perl Makefile.PL debug" will build debugging information for
  -      gdb/ms-vc++ into Embperl library.
  +     gdb/ms-vc++ into Embperl library.
  +   - Output is 8Bit clean. Now you can output strings that contains
  +     binary zeros from Embperl.
  +   - Syntax of Embperl is now defined in module HTML::Embperl::Syntax
  +   - Processing of Embperl is now divided in smaller steps:
  +        1 reading the source
  +        2 parseing 
  +        3 compiling 
  +        4 executing
  +        5 outputing
  +     Since steps 1-3 has only to take place for the first time a file
  +     is processed, Embperl is about 100% faster the Embperl 1.x.
  +     (Embperl 1.x has also precompiled the Perl code, but Embperl
  +     goes much further and stores also a precompiled structure of
  +     the document)
  +     This modularisation will also allow to replace single steps
  +     with other modules and to cascade multiple processors, that
  +     work on one document.
   
   
   =head1 1.3b4_dev -- That's what currently under developement
  
  
  
  1.104.2.5 +3 -2      embperl/Embperl.pm
  
  Index: Embperl.pm
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl.pm,v
  retrieving revision 1.104.2.4
  retrieving revision 1.104.2.5
  diff -u -r1.104.2.4 -r1.104.2.5
  --- Embperl.pm	2000/05/18 07:44:59	1.104.2.4
  +++ Embperl.pm	2000/05/19 13:35:25	1.104.2.5
  @@ -10,7 +10,7 @@
   #   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
   #   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
   #
  -#   $Id: Embperl.pm,v 1.104.2.4 2000/05/18 07:44:59 richter Exp $
  +#   $Id: Embperl.pm,v 1.104.2.5 2000/05/19 13:35:25 richter Exp $
   #
   ###################################################################################
   
  @@ -317,7 +317,8 @@
   # init on startup
   #
   
  -$DefaultLog = $ENV{EMBPERL_LOG} || $DefaultLog ;
  +$DefaultLog   = $ENV{EMBPERL_LOG} || $DefaultLog ;
  +$DebugDefault = $ENV{EMBPERL_DEBUG} || $DebugDefault ;
   if (defined ($ENV{MOD_PERL}))
       { 
       eval 'use Apache' ; # make sure Apache.pm is loaded (is not at server startup in mod_perl < 1.11)
  
  
  
  1.26.2.4  +1 -1      embperl/Embperl.xs
  
  Index: Embperl.xs
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl.xs,v
  retrieving revision 1.26.2.3
  retrieving revision 1.26.2.4
  diff -u -r1.26.2.3 -r1.26.2.4
  --- Embperl.xs	2000/05/16 12:44:20	1.26.2.3
  +++ Embperl.xs	2000/05/19 13:35:25	1.26.2.4
  @@ -614,7 +614,7 @@
   CODE:
       IV l ;
       char * s = SvPV (sText, l) ;
  -    Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, s, l) ;
  +    Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, s, l, 5) ;
   
   
   void
  
  
  
  1.23.2.3  +8 -2      embperl/ep.h
  
  Index: ep.h
  ===================================================================
  RCS file: /home/cvs/embperl/ep.h,v
  retrieving revision 1.23.2.2
  retrieving revision 1.23.2.3
  diff -u -r1.23.2.2 -r1.23.2.3
  --- ep.h	2000/05/16 12:44:20	1.23.2.2
  +++ ep.h	2000/05/19 13:35:26	1.23.2.3
  @@ -385,9 +385,9 @@
                           /*in*/  int            nMaxLen,
                           /*out*/ char *         sValue) ;
   
  -int    GetHashValueInt (/*in*/  HV *           pHash,
  +IV     GetHashValueInt (/*in*/  HV *           pHash,
                           /*in*/  const char *   sKey,
  -                        /*in*/  int            nDefault) ;
  +                        /*in*/  IV             nDefault) ;
   
   char * GetHashValueStr (/*in*/  HV *           pHash,
                           /*in*/  const char *   sKey,
  @@ -400,6 +400,12 @@
   
   void OutputToHtml (/*i/o*/ register req * r,
    		   /*i/o*/ const char *   sData) ;
  +
  +void OutputEscape (/*i/o*/ register req * r,
  + 		   /*in*/  const char *   sData,
  + 		   /*in*/  int            nDataLen,
  + 		   /*in*/  struct tCharTrans *   pEscTab,
  + 		   /*in*/  char           cEscChar) ;
   
   int TransHtml (/*i/o*/ register req * r,
   		/*i/o*/ char *         sData,
  
  
  
  1.1.2.8   +128 -102  embperl/Attic/epcomp.c
  
  Index: epcomp.c
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epcomp.c,v
  retrieving revision 1.1.2.7
  retrieving revision 1.1.2.8
  diff -u -r1.1.2.7 -r1.1.2.8
  --- epcomp.c	2000/05/18 07:44:59	1.1.2.7
  +++ epcomp.c	2000/05/19 13:35:26	1.1.2.8
  @@ -18,9 +18,12 @@
   struct tEmbperlCmd
       {
       const char *    sPerlCode ;
  +    const char *    sPerlCodeEnd ;
       int		    bRemoveNode ;
       } ;
   
  +typedef struct tEmbperlCmd tEmbperlCmd ;
  +
   char * pCode = NULL ;
   char * pProg = NULL ;
   
  @@ -64,148 +67,168 @@
   	nMaxEmbperlCmd = nNodeName ;
   
       pEmbperlCmds[nNodeName].sPerlCode = GetHashValueStr (pHash, "perlcode", "") ;
  +    pEmbperlCmds[nNodeName].sPerlCodeEnd = GetHashValueStr (pHash, "perlcodeend", NULL) ;
       pEmbperlCmds[nNodeName].bRemoveNode = GetHashValueInt (pHash, "removenode", 0) ;
   
  +
       if (r -> bDebug & dbgParse)
  -        lprintf (r, "[%d]EPCOMP: InitItem %s (#%d) perlcode=%s\n", r -> nPid, Ndx2String(nNodeName), nNodeName, pEmbperlCmds[nNodeName].sPerlCode) ; 
  +        lprintf (r, "[%d]EPCOMP: InitItem %s (#%d) perlcode=%s perlcodeend=%s\n", r -> nPid, Ndx2String(nNodeName), nNodeName, pEmbperlCmds[nNodeName].sPerlCode, pEmbperlCmds[nNodeName].sPerlCodeEnd?pEmbperlCmds[nNodeName].sPerlCodeEnd:"<undef>") ; 
   
       }
   
   
   
  -
  -
   /* ------------------------------------------------------------------------ */
   /*                                                                          */
  -/* embperl_CompileNode                                                      */
  +/* embperl_CompileCmd                                                       */
   /*                                                                          */
  -/* Compile one node and his childs                                          */
  +/* Compile one command inside a node                                        */
   /*                                                                          */
   /* ------------------------------------------------------------------------ */
   
   
  -embperl_CompileNode (/*in*/  tDomTree *   pDomTree,
  -		     /*in*/ tNode	    xNode)
  +embperl_CompileToPerlCode (/*in*/ tDomTree *   pDomTree,
  +		           /*in*/ tNodeData *	 pNode,
  +                           /*in*/ const char *  sPerlCode)
   
   
       {
  -    tNode xChildNode  ;
  -
  +    const char * p ;
  +    const char * q ;
       int    valid = 1 ;
  -    struct tNodeData * pNode = Node_self (pDomTree, xNode) ;
  -    tStringIndex nNdx = Node_selfNodeNameNdx (pNode) ;
   
  -    if (nNdx <= nMaxEmbperlCmd)
  +    if (sPerlCode)
   	{
  -	struct tEmbperlCmd * pCmd = &pEmbperlCmds[nNdx] ;
  -	if (pCmd)
  +	StringNew (&pCode, 512) ;
  +	p = strchr (sPerlCode, '%') ;	
  +	while (p)
   	    {
  -	    const char * sPerlCode ;
  -	    const char * p ;
  -	    const char * q ;
  -
  -	    if ((sPerlCode = pCmd -> sPerlCode))
  +	    int n = p - sPerlCode ;
  +	    if (n)
  +		StringAdd (&pCode, sPerlCode, n) ;
  +	    q = strchr (p+1, '%') ;	
  +	    if (q)
   		{
  -		StringNew (&pCode, 512) ;
  -		p = strchr (sPerlCode, '%') ;	
  -		while (p)
  +		if (p[1] == '#')
   		    {
  -		    int n = p - sPerlCode ;
  -		    if (n)
  -			StringAdd (&pCode, sPerlCode, n) ;
  -		    q = strchr (p+1, '%') ;	
  -		    if (q)
  +		    int nChildNo = atoi (&p[2]) ;
  +		    struct tNodeData * pChildNode = Node_selfNthChild (pDomTree, pNode, nChildNo) ;
  +
  +		    if (pChildNode)
  +			StringAdd (&pCode, Node_selfNodeName(pChildNode), 0) ;
  +		    else
  +			mydie ("missing child") ;			    
  +		    }
  +		else if (p[1] == '$')
  +		    {
  +		    if (p[2] == 'n')
   			{
  -			if (p[1] == '#')
  -			    {
  -			    int nChildNo = atoi (&p[2]) ;
  -			    struct tNodeData * pChildNode = Node_selfNthChild (pDomTree, pNode, nChildNo) ;
  +			char s [20] ;
  +			int  l = sprintf (s, "$_ep_DomTree,%u", pNode -> xNdx) ;
  +			StringAdd (&pCode, s, l) ; 
  +			}
  +		    }
  +		else
  +		    {
  +		    const char * sVal ;
   
  -			    if (pChildNode)
  -				StringAdd (&pCode, Node_selfNodeName(pChildNode), 0) ;
  -			    else
  -				mydie ("missing child") ;			    
  -			    }
  -			else if (p[1] == '$')
  -			    {
  -			    if (p[2] == 'n')
  -				{
  -				char s [20] ;
  -				int  l = sprintf (s, "$_ep_DomTree,%u", pNode -> xNdx) ;
  -				StringAdd (&pCode, s, l) ; 
  -				}
  -			    }
  -			else
  +		    if (p[1] == '!' || p[1] == '*')
  +			{
  +			sVal = Element_selfGetAttribut (pDomTree, pNode, p + 2, q - p - 2) ;
  +			if ((sVal && p[1] == '!') || (!sVal && p[1] == '*') )
   			    {
  -			    const char * sVal ;
  -
  -			    if (p[1] == '!' || p[1] == '*')
  -				{
  -				sVal = Element_selfGetAttribut (pDomTree, pNode, p + 2, q - p - 2) ;
  -				if ((sVal && p[1] == '!') || (!sVal && p[1] == '*') )
  -				    {
  -				    valid = 0 ;
  -				    break ;
  -				    }
  -				}
  -			    else
  -				sVal = Element_selfGetAttribut (pDomTree, pNode, p + 1, q - p - 1) ;
  -			    
  -			    if (sVal)
  -				{
  -				StringAdd (&pCode, "'",  1) ; 
  -				StringAdd (&pCode, sVal, 0) ; 
  -				StringAdd (&pCode, "'",  1) ; 
  -				}
  -			    else if (p[1] != '!') 
  -				StringAdd (&pCode, "''", 2) ; 
  +			    valid = 0 ;
  +			    break ;
   			    }
  -
  -			sPerlCode = q + 1 ;
  -			p = strchr (sPerlCode, '%') ;	
   			}
   		    else
  +			sVal = Element_selfGetAttribut (pDomTree, pNode, p + 1, q - p - 1) ;
  +		    
  +		    if (sVal)
   			{
  -			sPerlCode = p ;
  -			p = NULL ; 
  +			StringAdd (&pCode, sVal, 0) ; 
   			}
  -		    }
  -		if (valid)
  -		    {
  -		    StringAdd (&pProg, pCode, ArrayGetSize (pCode)) ;
  -		    StringAdd (&pProg, sPerlCode,  0) ; 
  -		    StringAdd (&pProg, "\n",  1) ; 
   		    }
  +
  +		sPerlCode = q + 1 ;
  +		p = strchr (sPerlCode, '%') ;	
   		}
  -	    if (pCmd -> bRemoveNode & 6)
  +	    else
   		{
  -		tNodeData *  pNextNode    = Node_selfNextSibling (pDomTree, pNode) ;
  -		const char * sText        = Node_selfNodeName (pNextNode) ;
  -		const char * p            = sText ;
  -
  -		while (*p && isspace (*p++))
  -		    ;
  -
  -		if (*p)
  -		    p-- ;
  -		if (p > sText && (pCmd -> bRemoveNode & 4))
  -		    p-- ;
  -
  -		if (p > sText)
  -		    { /* remove spaces */
  -		    if (*p)
  -			Node_replaceChildWithCDATA(pDomTree, -1, pNextNode -> xNdx, p, strlen (p)) ;
  -		    else
  -			Node_selfRemoveChild(pDomTree, -1, pNextNode) ;
  -		    }
  +		sPerlCode = p ;
  +		p = NULL ; 
   		}
  -	    if (pCmd -> bRemoveNode & 1)
  -		Node_selfRemoveChild(pDomTree, -1, pNode) ;
   	    }
  +	if (valid)
  +	    {
  +	    int l = ArrayGetSize (pCode) ;
  +            if (l)
  +                StringAdd (&pProg, pCode, l) ;
  +	    StringAdd (&pProg, sPerlCode,  0) ; 
  +	    StringAdd (&pProg, "\n",  1) ; 
  +	    }
   	}
  +    }
   
   
  -    
  +/* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* embperl_CompileNode                                                      */
  +/*                                                                          */
  +/* Compile one node and his childs                                          */
  +/*                                                                          */
  +/* ------------------------------------------------------------------------ */
  +
  +
  +embperl_CompileNode (/*in*/  tDomTree *   pDomTree,
  +		     /*in*/ tNode	    xNode)
  +
  +
  +    {
  +    tNode           xChildNode  ;
  +    tStringIndex    nNdx  ;
  +    tEmbperlCmd *   pCmd  ;
  +    tNodeData *     pNode = Node_self (pDomTree, xNode) ;
  +
  +    nNdx = Node_selfNodeNameNdx (pNode) ;
  +
  +    if (nNdx <= nMaxEmbperlCmd)
  +	{
  +	pCmd = &pEmbperlCmds[nNdx] ;
  +	if (pCmd)
  +            {
  +            embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sPerlCode) ;
  +
  +            if (pCmd -> bRemoveNode & 6)
  +	        {
  +	        tNodeData *  pNextNode    = Node_selfNextSibling (pDomTree, pNode) ;
  +	        const char * sText        = Node_selfNodeName (pNextNode) ;
  +	        const char * p            = sText ;
  +
  +	        while (*p && isspace (*p++))
  +	            ;
  +
  +	        if (*p)
  +	            p-- ;
  +	        if (p > sText && (pCmd -> bRemoveNode & 4))
  +	            p-- ;
  +
  +	        if (p > sText)
  +	            { /* remove spaces */
  +	            if (*p)
  +		        Node_replaceChildWithCDATA(pDomTree, -1, pNextNode -> xNdx, p, strlen (p), -1) ;
  +	            else
  +		        Node_selfRemoveChild(pDomTree, -1, pNextNode) ;
  +	            }
  +	        }
  +            if (pCmd -> bRemoveNode & 1)
  +	        Node_selfRemoveChild(pDomTree, -1, pNode) ;
  +            else if (pCmd -> bRemoveNode & 8)
  +	        pNode -> bFlags |= 8 ;
  +            }
  +        }
  +    else
  +        pCmd = NULL ;
       
       xChildNode = pNode -> bFlags?Node_firstChild (pDomTree, xNode):0 ;
   
  @@ -215,6 +238,9 @@
   
   	xChildNode  = Node_nextSibling (pDomTree, xChildNode) ;
   	}
  +
  +    if (pCmd)
  +        embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sPerlCodeEnd) ;
   
       }
   
  
  
  
  1.1.2.13  +52 -27    embperl/Attic/epdom.c
  
  Index: epdom.c
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epdom.c,v
  retrieving revision 1.1.2.12
  retrieving revision 1.1.2.13
  diff -u -r1.1.2.12 -r1.1.2.13
  --- epdom.c	2000/05/18 20:47:23	1.1.2.12
  +++ epdom.c	2000/05/19 13:35:26	1.1.2.13
  @@ -16,7 +16,7 @@
   #include "epmacro.h"
   
   HV * pStringTableHash ;	    /* Hash to translate strings to index number */
  -const char * * pStringTableArray  ;   /* Array with pointers to strings */
  +HE * * pStringTableArray  ;   /* Array with pointers to strings */
   
   tDomTree * pDomTrees ;
   
  @@ -288,27 +288,14 @@
       pSVKey = newSVpvn ((char *)sText, nLen) ;
       pHEKey = hv_store_ent (pStringTableHash, pSVKey, pSVNdx, 0) ;
   
  -    pStringTableArray[nNdx] = HeKEY (pHEKey) ;
  +    pStringTableArray[nNdx] = pHEKey ;
   
       numStr++ ;
   
       return nNdx ;    
       }
   
  -/* ------------------------------------------------------------------------ */
  -/*                                                                          */
  -/* Ndx2String                                                               */
  -/*                                                                          */
  -/* Get String from index		                                    */
  -/*                                                                          */
  -/* ------------------------------------------------------------------------ */
  -
  -const char * Ndx2String (/*in*/ tStringIndex 	nNdx)
   
  -    {
  -    return pStringTableArray[nNdx] ;
  -    }
  -
   /* ------------------------------------------------------------------------ */
   /*                                                                          */
   /* DomInit                                                                  */
  @@ -323,7 +310,7 @@
       {
       pStringTableHash = newHV () ;
   
  -    ArrayNew (&pStringTableArray, 128, sizeof (char *)) ; 
  +    ArrayNew (&pStringTableArray, 128, sizeof (HE *)) ; 
       String2Ndx ("", 0) ;
   
       ArrayNew (&pDomTrees, 16, sizeof (tDomTree)) ; 
  @@ -568,12 +555,22 @@
   	}
       else if (nType == ntypAttrValue)
   	{	    
  -	struct tAttrData * pNew = (struct tAttrData * )pDomTree -> pLookup[xParent] ; // ((struct tAttrData * )pParent + 1) + (pParent -> numAttr - 1);
  -	pNew -> xValue = String2Ndx (sText, nTextLen) ;
  +	struct tAttrData * pNew = (struct tAttrData * )pDomTree -> pLookup[xParent] ; 
  +        if (pNew -> nType != ntypAttr)
  +            {   
  +            if (!(xParent = Node_appendChild (pDomTree, ntypAttr, "a0", 2, xParent, nLevel)))
  +                return 0 ;
  +
  +	    pNew = (struct tAttrData * )pDomTree -> pLookup[xParent] ; 
  +            }
  +        
  +        
  +        
  +        pNew -> xValue = String2Ndx (sText, nTextLen) ;
   	if (pCurrReq -> bDebug & dbgParse)
   	    lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s AttributValue parent=%d node=%d type=%d text=%*.*s (#%d)\n", pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, pNew -> xNdx, nType, nTextLen, nTextLen, sText, sText?String2Ndx (sText, nTextLen):-1) ; 
   
  -	return 1 ;
  +	return xParent ;
   	}
       else
   	{
  @@ -709,12 +706,21 @@
   				  /*in*/ tNode		 xNode,
   				  /*in*/ tNode		 xOldChild,
   			          /*in*/ const char *	 sText,
  -				  /*in*/ int		 nTextLen)
  +				  /*in*/ int		 nTextLen,
  +				  /*in*/ int		 nEscMode)
   
       {
       struct tNodeData *	pOldChild  = Node_self (pDomTree, xOldChild) ;
       
  -    pOldChild -> nType = ntypCDATA ;
  +    if (nEscMode != -1)
  +	{
  +	pOldChild -> nType  = (nEscMode & 3)?ntypText:ntypCDATA ;
  +	pOldChild -> bFlags &= ~6 ;
  +	pOldChild -> bFlags |= (~nEscMode) & 6 ;
  +	}
  +    else
  +	pOldChild -> nType  = ntypCDATA ;
  +
       pOldChild -> nText = String2Ndx(sText, nTextLen) ;
       pOldChild -> xChilds = 0 ;
   
  @@ -889,7 +895,9 @@
   
   	lprintf (r, "[%d]toString: Node=%d type=%d flags=%x text=>%s<= (#%d)\n", r, xNode, pNode -> nType,  pNode -> bFlags, Ndx2String (pNode -> nText), pNode -> nText) ; 
   
  -	if (pNode -> nType == ntypTag || pNode -> nType == ntypStartTag)
  +	if (pNode -> bFlags & 8)
  +            ;
  +        else if (pNode -> nType == ntypTag || pNode -> nType == ntypStartTag)
   	    {
   	    int n = pNode -> numAttr ;
   	    struct tAttrData * pAttr = (struct tAttrData *)(pNode + 1) ;
  @@ -899,24 +907,41 @@
   	    
   	    while (n--)
   		{
  -		oputs (r, pStringTableArray[pAttr -> xName]) ;
  +		char * s ;
  +		int    l ;
  +		Ndx2StringLen (pAttr -> xName,s,l) ;
  +		oputc (r, ' ') ;
  +	        owrite (r, s, l);
   		if (pAttr -> xValue)
   		    {
   		    oputs (r, "=\"") ;
  -		    oputs (r, pStringTableArray[pAttr -> xValue]) ;	
  +		    Ndx2StringLen (pAttr -> xValue, s, l) ;
  +		    owrite (r, s, l) ;
   		    oputc (r, '"') ;
   		    }
   		}
   	    oputc (r, '>') ;
   	    pAttr++ ;
   	    }
  -	else
  -	    oputs (r, Node_selfNodeName (pNode)) ;
  +	else if (pNode -> nType == ntypText)
  +	    {
  +	    char * s ;
  +	    int    l ;
  +	    Ndx2StringLen (pNode -> nText,s,l) ;
  +	    OutputEscape (r, s, l, (pNode -> bFlags & 2)?Char2Url:Char2Html, (pNode -> bFlags & 4)?'\\':0) ;
  +	    }
  +	else 
  +	    {
  +	    char * s ;
  +	    int    l ;
  +	    Ndx2StringLen (pNode -> nText,s,l) ;
  +	    owrite (r, s, l);
  +	    }
   
   	
   	Node_toString (pDomTree, r, xNode) ;
   
  -	if (pNode -> nType == ntypStartTag)
  +	if (pNode -> nType == ntypStartTag && (pNode -> bFlags & 8) == 0)
   	    {
   	    oputs (r, "</") ;
   	    oputs (r, Node_selfNodeName (pNode)) ;
  
  
  
  1.1.2.9   +34 -11    embperl/Attic/epdom.h
  
  Index: epdom.h
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epdom.h,v
  retrieving revision 1.1.2.8
  retrieving revision 1.1.2.9
  diff -u -r1.1.2.8 -r1.1.2.9
  --- epdom.h	2000/05/18 07:45:00	1.1.2.8
  +++ epdom.h	2000/05/19 13:35:26	1.1.2.9
  @@ -83,16 +83,36 @@
     Node Types
   */
   
  +/* ------------------------------------------------------------------------ 
   
  +interface Node {
  +  // NodeType
  +  const unsigned short      ELEMENT_NODE                   = 1;
  +  const unsigned short      ATTRIBUTE_NODE                 = 2;
  +  const unsigned short      TEXT_NODE                      = 3;
  +  const unsigned short      CDATA_SECTION_NODE             = 4;
  +  const unsigned short      ENTITY_REFERENCE_NODE          = 5;
  +  const unsigned short      ENTITY_NODE                    = 6;
  +  const unsigned short      PROCESSING_INSTRUCTION_NODE    = 7;
  +  const unsigned short      COMMENT_NODE                   = 8;
  +  const unsigned short      DOCUMENT_NODE                  = 9;
  +  const unsigned short      DOCUMENT_TYPE_NODE             = 10;
  +  const unsigned short      DOCUMENT_FRAGMENT_NODE         = 11;
  +  const unsigned short      NOTATION_NODE                  = 12;
  +
  +*/
  +
   enum tNodeType
       {
       ntypPad	    = -1,
  -    ntypCDATA	    = 1,
  -    ntypTag	    = 2,
  -    ntypStartTag    = 3,
  -    ntypEndTag	    = 4,
  -    ntypAttr	    = 5,
  -    ntypAttrValue   = 6,
  +    ntypTag	    = 1,
  +    ntypStartTag    = 1 + 0x20,
  +    ntypEndTag	    = 1 + 0x40,
  +    ntypEndStartTag = 1 + 0x60,
  +    ntypAttr	    = 2,
  +    ntypAttrValue   = 2 + 0x20,
  +    ntypText	    = 3,
  +    ntypCDATA	    = 4,
       } ;
   
   
  @@ -109,14 +129,16 @@
   
   
   extern tDomTree  *    pDomTrees ;	     /* Array with all Dom Trees */
  -extern const char * * pStringTableArray  ;   /* Array with pointers to strings */
  +extern HE * *	      pStringTableArray  ;   /* Array with pointers to strings */
   
   
   
   tStringIndex String2Ndx (/*in*/ const char *	    sText,
   			 /*in*/ int		    nLen) ;
  +
   
  -const char * Ndx2String (/*in*/ tStringIndex 	nNdx) ;
  +#define Ndx2String(nNdx) (HeKEY (pStringTableArray[nNdx]))
  +#define Ndx2StringLen(nNdx,sVal,nLen) { HE * pHE = pStringTableArray[nNdx] ; nLen=HeKLEN(pHE) ; sVal = HeKEY (pHE) ; }
   
   
   int ArrayNew (/*in*/ const tArray * pArray,
  @@ -165,8 +187,8 @@
   #define Node_self(pDomTree,xNode)	    ((struct tNodeData *)(pDomTree -> pLookup[xNode]))
   
   #define Node_selfNodeNameNdx(pNode)	    (pNode -> nText) ;
  -#define Node_selfNodeName(pNode)	    (pStringTableArray[pNode -> nText])
  -#define Node_nodeName(pDomTree,pNode)	    (pStringTableArray[Node_self (pDomTree,xNode) -> nText])
  +#define Node_selfNodeName(pNode)	    (Ndx2String (pNode -> nText))
  +#define Node_nodeName(pDomTree,pNode)	    (Ndx2String (Node_self (pDomTree,xNode) -> nText))
   
   void Node_toString (/*in*/ tDomTree *  pDomTree,
   		    /*i/o*/ register req * r,
  @@ -184,7 +206,8 @@
   				  /*in*/ tNode		 xNode,
   				  /*in*/ tNode		 xOldChild,
   			          /*in*/ const char *	 sText,
  -				  /*in*/ int		 nTextLen) ;
  +				  /*in*/ int		 nTextLen,
  +				  /*in*/ int		 nEscMode) ;
   
   
   
  
  
  
  1.1.2.12  +66 -24    embperl/Attic/epparse.c
  
  Index: epparse.c
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epparse.c,v
  retrieving revision 1.1.2.11
  retrieving revision 1.1.2.12
  diff -u -r1.1.2.11 -r1.1.2.12
  --- epparse.c	2000/05/16 12:44:22	1.1.2.11
  +++ epparse.c	2000/05/19 13:35:26	1.1.2.12
  @@ -20,17 +20,19 @@
   
   struct tToken
       {
  -    const char *    sText ;     /* string of token */
  -    int             nTextLen ;  /* len of string */
  -    const char *    sEndText ;  /* string which ends the block */
  -    const char *    sNodeName;  /* name of the node to create */
  -    int		    nNodeName ; /* index in string table of node name */
  -    enum tNodeType  nNodeType ; /* type of the node that should be created */
  -    enum tNodeType  nCDataType ; /* type of the node that should be created */
  -    int             bUnescape ;    /* translate input?  */
  -    unsigned char *      pContains ; /* chars that could becontains in the string */
  -    struct tTokenTable * pFollowedBy ; /* table of tokens that can follow this one */
  -    struct tTokenTable * pInside ;   /* table of tokens that can apear inside this one */
  +    const char *	    sText ;	/* string of token (MUST be first item!) */
  +    const char *	    sName ;	/* name of token (only for description) */
  +    int			    nTextLen ;	/* len of string */
  +    const char *	    sEndText ;	/* string which ends the block */
  +    const char *	    sNodeName;	/* name of the node to create */
  +    int			    nNodeName ;	/* index in string table of node name */
  +    enum tNodeType	    nNodeType ;	/* type of the node that should be created */
  +    enum tNodeType	    nCDataType ;/* type of the node that should be created */
  +    int			    bUnescape ;	/* translate input?  */
  +    unsigned char *	    pContains ;	/* chars that could becontains in the string */
  +    struct tTokenTable *    pFollowedBy;/* table of tokens that can follow this one */
  +    struct tTokenTable *    pInside ;	/* table of tokens that can apear inside this one */
  +    struct tToken      *    pEndTag ;	/* token that contains definition for the end of the current token */
       } ;        
   
   struct tTokenTable
  @@ -40,7 +42,7 @@
       struct tToken * pTokens ;	    /* table with all tokens */
       int             numTokens ;	    /* number of tokens in above table */
       int		    bLSearch ;	    /* when set perform a linear, instead of a binary search */
  -    struct tToken * pContainsToken ;
  +    struct tToken * pContainsToken ;/* pointer to the token that has a pContains defined (could be only one per table) */
       } ;
   
   
  @@ -168,6 +170,7 @@
       if (ppSV != NULL)
   	{		
   	struct tTokenTable * pNewTokenTable ;
  +	HV *                 pSubHash ;
   
   	if (*ppSV == NULL || !SvROK (*ppSV) || SvTYPE (SvRV (*ppSV)) != SVt_PVHV)
   	    {
  @@ -176,16 +179,26 @@
   	    return rcNotHashRef ;
   	    }
   	
  -	if ((pNewTokenTable = _malloc (r, sizeof (struct tTokenTable))) == NULL)
  -	     return rcOutOfMemory ;
  +	pSubHash = (HV *)SvRV (*ppSV) ;
  +	if ((pNewTokenTable = (struct tTokenTable *)GetHashValueInt (pSubHash, "--cptr", 0)) == NULL)
  +	    {
  +	    if ((pNewTokenTable = _malloc (r, sizeof (struct tTokenTable))) == NULL)
  +		 return rcOutOfMemory ;
   
  -        if (r -> bDebug & dbgBuildToken)
  -            lprintf (r, "[%d]TOKEN: -> %s\n", r -> nPid, pAttr) ; 
  -	if ((rc = BuildTokenTable (r, (HV *)SvRV (*ppSV), pDefEnd, pNewTokenTable)))
  -	    return rc ;    
  -        if (r -> bDebug & dbgBuildToken)
  -            lprintf (r, "[%d]TOKEN: <- %s\n", r -> nPid, pAttr) ; 
  +	    if (r -> bDebug & dbgBuildToken)
  +		lprintf (r, "[%d]TOKEN: -> %s\n", r -> nPid, pAttr) ; 
  +	    if ((rc = BuildTokenTable (r, pSubHash, pDefEnd, pNewTokenTable)))
  +		return rc ;    
  +	    if (r -> bDebug & dbgBuildToken)
  +		lprintf (r, "[%d]TOKEN: <- %s\n", r -> nPid, pAttr) ; 
  +	    
  +	    hv_store(pSubHash, "--cptr", sizeof ("--cptr") - 1, newSViv ((IV)pNewTokenTable), 0) ;
  +	    }
  +	else
  +	    if (r -> bDebug & dbgBuildToken)
  +	        lprintf (r, "[%d]TOKEN: -> %s already build\n", r -> nPid, pAttr) ; 
   	
  +
   	*pTokenTable = pNewTokenTable ;
   	return  ok  ;
   	}
  @@ -271,6 +284,7 @@
   	    pHash = (HV *)SvRV (pToken) ;
           
   	    p = &pTable[n] ;
  +	    p -> sName     = pKey ;
   	    p -> sText     = GetHashValueStr (pHash, "text", "") ;
   	    p -> nTextLen  = strlen (p -> sText) ;
   	    p -> sEndText  = GetHashValueStr (pHash, "end", pDefEnd) ;
  @@ -278,6 +292,7 @@
   	    p -> nNodeType = GetHashValueInt (pHash, "nodetype", ntypTag) ;
   	    p -> bUnescape = GetHashValueInt (pHash, "unescape", 0) ;
   	    p -> nCDataType = GetHashValueInt (pHash, "cdatatype", ntypCDATA) ;
  +	    p -> pEndTag    = (struct tToken *)GetHashValueStr (pHash, "nodename", NULL) ;
   	    if (sContains  = GetHashValueStr (pHash, "contains", NULL))
   		{
   		unsigned char * pC ;
  @@ -326,7 +341,6 @@
   		return rc ;
   	    p -> pInside     = pNewTokenTable ;
   
  -	    
   	    n++ ;
   	    }
   	}
  @@ -335,8 +349,30 @@
   
   
       for (i = 0; i < n; i++)
  +	{
   	if (pTable[i].pContains)
   	    pTokenTable -> pContainsToken = &pTable[i] ;
  +        if (pTable[i].pEndTag)
  +	    {
  +	    char * s = (char *)pTable[i].pEndTag ;
  +	    int    j ;
  +
  +	    pTable[i].pEndTag = NULL ;
  +	    for (j = 0; j < n; j++)
  +		{
  +		if (strcmp (pTable[j].sName, s) == 0)
  +		    pTable[i].pEndTag = &pTable[j] ;
  +		}
  +	    if (pTable[i].pEndTag == NULL)
  +		{
  +		strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1)) ;
  +		sprintf (r -> errdat2, " EndTag %s not found", s) ;
  +		return rcNotFound ;
  +		}
  +	    
  +	    }
  +        }
  +
       
       p = &pTable[n] ;
       p -> sText = "" ;
  @@ -496,6 +532,11 @@
   		    }
   		else
   		    {
  +		    if (pToken -> nNodeType == ntypEndStartTag && level > 0)
  +			{
  +			xParentNode = Node_parentNode  (r -> pCurrDomTree, xParentNode) ;
  +			level-- ;
  +			}
   		    if (!(xNewNode = Node_appendChild (r -> pCurrDomTree, pToken -> nNodeType, pNodeName, strlen (pNodeName), xParentNode, level)))
   			return rc ;
   		    
  @@ -523,19 +564,20 @@
   
   			if (pEndCurr)
   			    {
  -			    if (pEndCurr - pCurr && pToken -> nCDataType)
  +			    tNode xNewAttrNode ;
  +                            if (pEndCurr - pCurr && pToken -> nCDataType)
   				{
   				if (pToken -> bUnescape)
   				    TransHtml (r, pCurr, pEndCurr - pCurr) ;
   
  -				if (!(xNewNode = Node_appendChild (r -> pCurrDomTree, pToken -> nCDataType, pCurr, pEndCurr - pCurr, xNewNode, level+1)))
  +				if (!(xNewAttrNode = Node_appendChild (r -> pCurrDomTree, pToken -> nCDataType, pCurr, pEndCurr - pCurr, xNewNode, level+1)))
   				    return 1 ;
   				}
   			    pCurr = pEndCurr + nSkip ;
   			    }
   			}
   
  -		    if (pToken -> nNodeType == ntypStartTag)
  +		    if (pToken -> nNodeType == ntypStartTag || pToken -> nNodeType == ntypEndStartTag)
   			{
   			level++ ;
   			xParentNode = xNewNode ;
  
  
  
  1.14.2.1  +64 -3     embperl/eputil.c
  
  Index: eputil.c
  ===================================================================
  RCS file: /home/cvs/embperl/eputil.c,v
  retrieving revision 1.14
  retrieving revision 1.14.2.1
  diff -u -r1.14 -r1.14.2.1
  --- eputil.c	2000/05/02 04:41:38	1.14
  +++ eputil.c	2000/05/19 13:35:26	1.14.2.1
  @@ -69,6 +69,66 @@
       }
   
   
  +/* ---------------------------------------------------------------------------- */
  +/*                                                                              */
  +/* Output a string and escape it                                                */
  +/*                                                                              */
  +/* in sData     = input:  string                                                */
  +/*    nDataLen  = input:  length of string                                      */
  +/*    pEscTab   = input:  escape table                                          */
  +/*    cEscChar  = input:  char to escape escaping (0 = off)                     */
  +/*                                                                              */
  +/* ---------------------------------------------------------------------------- */
  +
  +void OutputEscape (/*i/o*/ register req * r,
  + 		   /*in*/  const char *   sData,
  + 		   /*in*/  int            nDataLen,
  + 		   /*in*/  struct tCharTrans *   pEscTab,
  + 		   /*in*/  char           cEscChar)
  +
  +    {
  +    char * pHtml  ;
  +    const char * p ;
  +    int	         l ;
  +
  +    EPENTRY (OutputEscape) ;
  +
  +    if (pEscTab == NULL)
  +        {
  +        owrite (r, sData, nDataLen) ;
  +        return ;
  +        }
  +
  +    p = sData ;
  +    l = nDataLen ;
  +
  +    while (l > 0)
  +        {
  +        if (cEscChar && *sData == cEscChar)
  +            {
  +            if (p != sData)
  +                owrite (r, p, sData - p) ;
  +            sData++, l-- ;
  +            p = sData ;
  +            }
  +        else
  +            {
  +            pHtml = r -> pCurrEscape[(unsigned char)(*sData)].sHtml ;
  +            if (*pHtml)
  +                {
  +                if (p != sData)
  +                    owrite (r, p, sData - p) ;
  +                oputs (r, pHtml) ;
  +                p = sData + 1;
  +                }
  +            }
  +        sData++, l-- ;
  +        }
  +    if (p != sData)
  +        owrite (r, p, sData - p) ;
  +    }
  +
  +
   #if 0
   
   /* ---------------------------------------------------------------------------- */
  @@ -481,9 +541,9 @@
   
   
   
  -int    GetHashValueInt (/*in*/  HV *           pHash,
  -                        /*in*/  const char *   sKey,
  -                        /*in*/  int            nDefault)
  +IV  GetHashValueInt (/*in*/  HV *           pHash,
  +                     /*in*/  const char *   sKey,
  +                     /*in*/  IV            nDefault)
   
       {
       SV **   ppSV ;
  @@ -496,6 +556,7 @@
           
       return nDefault ;
       }
  +
   
   
   char * GetHashValueStr (/*in*/  HV *           pHash,
  
  
  
  1.57.2.6  +19 -13    embperl/test.pl
  
  Index: test.pl
  ===================================================================
  RCS file: /home/cvs/embperl/test.pl,v
  retrieving revision 1.57.2.5
  retrieving revision 1.57.2.6
  diff -u -r1.57.2.5 -r1.57.2.6
  --- test.pl	2000/05/16 12:44:22	1.57.2.5
  +++ test.pl	2000/05/19 13:35:26	1.57.2.6
  @@ -7,9 +7,9 @@
   ##    'input.htm?feld5=Wert5&feld6=Wert6&feld7=Wert7&feld8=Wert8&cb5=cbv5&cb6=cbv6&cb7=cbv7&cb8=cbv8&cb9=ncbv9&cb10=ncbv10&cb11=ncbv11&mult=Wert3&mult=Wert6&esc=a<b&escmult=a>b&escmult=Wert3',
   ##    'ascii',
   ##    'pure.htm',
  -    'plain.htm',
  -    'plain.htm',
  -    'plain.htm',
  +##    'plain.htm',
  +##    'plain.htm',
  +##    'plain.htm',
   ##    'plainblock.htm',
   ##    'plainblock.htm',
   ##    'error.htm???8',
  @@ -138,6 +138,22 @@
   
       print "\nloading...                    ";
       
  +
  +    $defaultdebug = 0x1f85ffd ;
  +    #$defaultdebug = 1 ;
  +
  +    #### setup paths #####
  +
  +    $inpath  = 'test/html' ;
  +    $tmppath = 'test/tmp' ;
  +    $cmppath = 'test/cmp' ;
  +
  +    $logfile    = "$tmppath/test.log" ;
  +
  +    $ENV{EMBPERL_LOG} = $logfile ;
  +    $ENV{EMBPERL_DEBUG} = $defaultdebug ;
  +
  +    unlink ($logfile) ;
       }
   
   END 
  @@ -175,12 +191,6 @@
   
   die "You must install libwin32 first" if ($EPWIN32 && $win32loaderr && $EPHTTPD) ;
   
  -#### setup paths #####
  -
  -$inpath  = 'test/html' ;
  -$tmppath = 'test/tmp' ;
  -$cmppath = 'test/cmp' ;
  -
   
   #### setup files ####
   
  @@ -189,7 +199,6 @@
   $httpderr   = "$tmppath/httpd.err.log" ;
   $offlineerr = "$tmppath/test.err.log" ;
   $outfile    = "$tmppath/out.htm" ;
  -$logfile    = "$tmppath/test.log" ;
   
   #### setup path in URL ####
   
  @@ -207,8 +216,6 @@
   $port    = $EPPORT ;
   $host    = 'localhost' ;
   $httpdpid = 0 ;
  -$defaultdebug = 0x1f85ffd ;
  -#$defaultdebug = 1 ;
   #$ignoreerror = 1 ;
   
   if ($cmdarg =~ /\?/)
  @@ -613,7 +620,6 @@
   chmod 0777, $tmppath ;
   umask $um ;
   
  -unlink ($logfile) ;
   unlink ($outfile) ;
   unlink ($httpderr) ;
   unlink ($offlineerr) ;
  
  
  
  No                   revision
  
  
  No                   revision
  
  
  1.1.2.2   +57 -12    embperl/Embperl/Attic/Syntax.pm
  
  Index: Syntax.pm
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
  retrieving revision 1.1.2.1
  retrieving revision 1.1.2.2
  diff -u -r1.1.2.1 -r1.1.2.2
  --- Syntax.pm	2000/05/18 07:45:03	1.1.2.1
  +++ Syntax.pm	2000/05/19 13:35:30	1.1.2.2
  @@ -10,7 +10,7 @@
   #   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
   #   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
   #
  -#   $Id: Syntax.pm,v 1.1.2.1 2000/05/18 07:45:03 richter Exp $
  +#   $Id: Syntax.pm,v 1.1.2.2 2000/05/19 13:35:30 richter Exp $
   #
   ###################################################################################
   
  @@ -18,12 +18,14 @@
   
   package HTML::Embperl::Syntax ;
   
  -use constant  ntypCDATA	    => 1 ;
  -use constant  ntypTag       => 2 ;
  -use constant  ntypStartTag  => 3 ;
  -use constant  ntypEndTag    => 4 ;
  -use constant  ntypAttr	    => 5 ;
  -use constant  ntypAttrValue => 6 ;
  +use constant  ntypTag           => 1 ;
  +use constant  ntypStartTag      => 1 + 0x20 ;
  +use constant  ntypEndTag        => 1 + 0x40 ;
  +use constant  ntypEndStartTag   => 1 + 0x60 ;
  +use constant  ntypAttr	        => 2 ;
  +use constant  ntypAttrValue     => 2 + 0x20 ;
  +use constant  ntypText	        => 3 ;
  +use constant  ntypCDATA	        => 4 ;
   
   
   %Attr = (
  @@ -74,7 +76,7 @@
               'value' => { 'text' => 'value', 'nodename' => 'value', follow => \%AssignAttr },
               },
           'procinfo' => {
  -            embperl => { perlcode => 'Input (%$n%, %*type%, %*name% %!value%) ;' }
  +            embperl => { perlcode => 'Input (%$n%, \'%*type%\', \'%*name%\' %!value%) ;' }
               },
            },
       'tr' => {
  @@ -138,60 +140,99 @@
   %MetaCmds = (
       'if' => {
           'text' => 'if',
  +        'nodetype'   => ntypStartTag, 
  +        'cdatatype'  => ntypAttrValue,
  +        'unescape' => 1,
  +        'endtag'   => 'endif',
           'procinfo' => {
  -            embperl => { perlcode => 'if (%#0%) { ' }
  +            embperl => { 
  +                perlcode => 'if (%a0%) { ', 
  +                perlcodeend => '}',
  +                removenode => 8,
  +                }
               },
            },
       'else' => {
           'text' => 'else',
  +        'nodetype'   => ntypEndStartTag, 
  +        'unescape' => 1,
  +        'endtag'   => 'endif',
           'procinfo' => {
  -            embperl => { perlcode => '} else {' }
  +            embperl => { 
  +                perlcode => 'else {',
  +                perlcodeend => '}',
  +                removenode => 8,
  +                }
               },
            },
       'endif' => {
           'text' => 'endif',
  +        'nodetype'   => ntypEndTag, 
  +        'unescape' => 1,
           'procinfo' => {
  -            embperl => { perlcode => '} ;' }
  +            embperl => { perlcode => '}' }
               },
            },
       'elsif' => {
           'text' => 'elseif',
  +        'nodetype'   => ntypEndStartTag, 
  +        'unescape' => 1,
  +        'endtag'   => 'endif',
           'procinfo' => {
  -            embperl => { perlcode => '} elsif (%#0%) { ' }
  +            embperl => { 
  +                perlcode => 'elsif (%#0%) { ', 
  +                perlcodeend => '}',
  +                removenode => 8,
  +                }
               },
            },
       'while' => {
           'text' => 'while',
  +        'nodetype'   => ntypStartTag, 
  +        'unescape' => 1,
  +        'endtag'   => 'endwhile',
           'procinfo' => {
               embperl => { perlcode => 'while (%#0%) { ' }
               },
            },
       'endwhile' => {
           'text' => 'endwhile',
  +        'nodetype'   => ntypEndTag, 
  +        'unescape' => 1,
           'procinfo' => {
               embperl => { perlcode => '} ;' }
               },
            },
       'foreach' => {
           'text' => 'foreach',
  +        'nodetype'   => ntypStartTag, 
  +        'unescape' => 1,
  +        'endtag'   => 'endforeach',
           'procinfo' => {
               embperl => { perlcode => 'foreach (%#0%) { ' }
               },
            },
       'endforeach' => {
           'text' => 'endforeach',
  +        'nodetype'   => ntypEndTag, 
  +        'unescape' => 1,
           'procinfo' => {
               embperl => { perlcode => '} ;' }
               },
            },
       'do' => {
           'text' => 'do',
  +        'nodetype'   => ntypStartTag, 
  +        'unescape' => 1,
  +        'endtag'   => 'until',
           'procinfo' => {
               embperl => { perlcode => 'do { ' }
               },
            },
       'until' => {
           'text' => 'until',
  +        'nodetype'   => ntypEndTag, 
  +        'unescape' => 1,
           'procinfo' => {
               embperl => { perlcode => '} until (%#0%) ; ' }
               },
  @@ -319,6 +360,10 @@
   =item 'cdatatype'  => ntypAttrValue
   
   Type of nodes for data inside this node.
  +
  +=item endtag
  +
  +Name of the tag that marks the end of a block.
   
   =item 'follow' => \%HtmlTags