perl-embperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From rich...@locus.apache.org
Subject cvs commit: embperl/Embperl Syntax.pm
Date Fri, 26 May 2000 23:31:11 GMT
richter     00/05/26 16:31:11

  Modified:    .        Tag: Embperl2 Embperl.xs epcomp.c epdom.c epdom.h
               Embperl  Tag: Embperl2 Syntax.pm
  Log:
  - Embperl 2
  
  Revision  Changes    Path
  No                   revision
  
  
  No                   revision
  
  
  1.26.2.10 +39 -3     embperl/Embperl.xs
  
  Index: Embperl.xs
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl.xs,v
  retrieving revision 1.26.2.9
  retrieving revision 1.26.2.10
  diff -u -r1.26.2.9 -r1.26.2.10
  --- Embperl.xs	2000/05/24 14:33:25	1.26.2.9
  +++ Embperl.xs	2000/05/26 23:31:03	1.26.2.10
  @@ -628,7 +628,7 @@
   MODULE = HTML::Embperl      PACKAGE = XML::Embperl::DOM     PREFIX = embperl_
   
   
  -void
  +SV *
   embperl_Node_replaceChildWithCDATA (xDomTree, xOldChild,sText)
       int xDomTree
       int xOldChild
  @@ -639,9 +639,12 @@
       Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, s, l, (pCurrReq
-> nCurrEscMode & 3)== 3?1 + (pCurrReq -> nCurrEscMode & 4):pCurrReq -> nCurrEscMode,
nflgModified | nflgReturn) ;
       pCurrReq -> nCurrEscMode = pCurrReq -> nEscMode ;
       pCurrReq -> bEscModeSet = -1 ;
  -
  +    SvREFCNT_inc (sText) ;
  +    RETVAL = sText ;
  +OUTPUT:
  +    RETVAL
   
  -void
  +SV *
   embperl_Node_replaceChildWithUrlDATA (xDomTree, xOldChild,sText)
       int xDomTree
       int xOldChild
  @@ -686,6 +689,10 @@
   
       pCurrReq -> nCurrEscMode = pCurrReq -> nEscMode ;
       pCurrReq -> bEscModeSet = -1 ;
  +    SvREFCNT_inc (sText) ;
  +    RETVAL = sText ;
  +OUTPUT:
  +    RETVAL
   
   
   void
  @@ -715,3 +722,32 @@
   
   
   
  +void
  +embperl_Element_setAttribut (xDomTree, xNode, sAttr, sText)
  +    int xDomTree
  +    int xNode
  +    SV * sAttr
  +    SV * sText
  +CODE:
  +    IV nAttr ;
  +    IV nText ;
  +    char * sT = SvPV (sText, nText) ;
  +    char * sA = SvPV (sAttr, nAttr) ;
  +    tDomTree * pDomTree = DomTree_self (xDomTree) ;
  +
  +    Element_selfSetAttribut (pDomTree, Node_self (pDomTree, xNode), sA, nAttr, sT, nText)
;
  +
  +
  +
  +
  +void
  +embperl_Element_removeAttribut (xDomTree, xNode, sAttr)
  +    int xDomTree
  +    int xNode
  +    SV * sAttr
  +CODE:
  +    IV nAttr ;
  +    char * sA = SvPV (sAttr, nAttr) ;
  +    tDomTree * pDomTree = DomTree_self (xDomTree) ;
  +
  +    Element_selfRemoveAttribut (pDomTree, Node_self (pDomTree, xNode), sA, nAttr) ;
  
  
  
  1.1.2.15  +206 -53   embperl/Attic/epcomp.c
  
  Index: epcomp.c
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epcomp.c,v
  retrieving revision 1.1.2.14
  retrieving revision 1.1.2.15
  diff -u -r1.1.2.14 -r1.1.2.15
  --- epcomp.c	2000/05/24 21:08:17	1.1.2.14
  +++ epcomp.c	2000/05/26 23:31:04	1.1.2.15
  @@ -76,7 +76,7 @@
       if (ppSV != NULL && *ppSV != NULL && 
           SvTYPE(*ppSV) == SVt_RV && SvTYPE((pAV = (AV *)SvRV(*ppSV))) == SVt_PVAV)
   	{ /* Array reference  */
  -	int f = AvFILL(pAV)  ;
  +	int f = AvFILL(pAV) + 1 ;
           int i ;
           IV l ;
           char * s ;
  @@ -84,7 +84,7 @@
           pEmbperlCmds[nNodeName].sPerlCode = malloc (f * sizeof (char *)) ;
           pEmbperlCmds[nNodeName].numPerlCode = f ;
   
  -        for (i = 0; i <= f; i++)
  +        for (i = 0; i < f; i++)
   	    {
   	    ppSV = av_fetch (pAV, i, 0) ;
   	    if (ppSV && *ppSV)
  @@ -115,12 +115,184 @@
   
       }
   
  +/* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* 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_CompileAddChildNode                                              */
  +/*                                                                          */
  +/* Add value of child node to perl code                                     */
  +/*                                                                          */
  +/* ------------------------------------------------------------------------ */
   
   
  +int embperl_CompileAddChildNode (/*in*/ tDomTree *   pDomTree,
  +    		                 /*in*/ tNodeData *	 pNode,
  +				        const char * p,
  +					const char * q,
  +					char op,
  +					char out)
  +
  +
  +
  +    {
  +    const char * or ;
  +    const char * eq = strchr (p, ':') ;
  +    const char * e = eq?eq:q;
  +    int nChildNo = atoi (p) ;
  +    struct tNodeData * pChildNode = Node_selfNthChild (pDomTree, pNode, nChildNo) ;
  +    const char * sText = Node_selfNodeName(pChildNode) ;
  +    
  +    if (op == '=' && eq)
  +	{
  +	eq++ ;
  +	do
  +	    {
  +	    or = strchr (eq + 1, '|') ;
  +	    e = or?or - 1:q - 1 ;
  +	    if (strncmp (sText, eq, e - eq) == 0)
  +		break ;
  +	    if (or == NULL)
  +		return 0 ;
  +	    eq = or + 1 ;
  +	    }
  +	while (or) ;
  +	}
  +    else if (op == '~' && eq)
  +	{
  +	eq++ ;
  +	do 
  +	    {
  +	    or = strchr (eq + 1, '|') ;
  +	    e = or?or - 1:q - 1 ;
  +	    if (strstrn (sText, eq, e - eq))
  +		break ;
  +	    if (or == NULL)
  +		return 0 ;
  +	    eq = or + 1 ;
  +	    }
  +	while (or) ;
  +	}
  +    else if (op == '!' && pChildNode)
  +	{
  +	return 0 ;
  +	}
  +    else if (op == '*' && !pChildNode)
  +	{
  +	return 0 ;
  +	}
  +
  +    if (pChildNode && out)
  +	StringAdd (&pCode, sText, 0) ;
  +    else
  +	; // mydie ("missing child") ;			    
  +
  +    return 1 ;
  +    }
  +
   /* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* embperl_CompileAddAttribut                                               */
   /*                                                                          */
  -/* embperl_CompileCmd                                                       */
  +/* Add value of child node to perl code                                     */
   /*                                                                          */
  +/* ------------------------------------------------------------------------ */
  +
  +
  +int embperl_CompileAddAttribut (/*in*/ tDomTree *   pDomTree,
  +    		                 /*in*/ tNodeData *	 pNode,
  +				        const char * p,
  +					const char * q,
  +					char op,
  +					char out)
  +
  +
  +
  +    {
  +    const char * or ;
  +    const char * eq = strchr (p, ':') ;
  +    const char * e = eq?eq:q;
  +    tAttrData * pChildNode = Element_selfGetAttribut (pDomTree, pNode, p, e - p) ;
  +    const char * sText = Ndx2String (pChildNode -> xName) ;
  +
  +    if (op == '=' && eq)
  +	{
  +	eq++ ;
  +	do
  +	    {
  +	    or = strchr (eq + 1, '|') ;
  +	    e = or?or - 1:q - 1 ;
  +	    if (strncmp (sText, eq, e - eq) == 0)
  +		break ;
  +	    if (or == NULL)
  +		return 0 ;
  +	    eq = or + 1 ;
  +	    }
  +	while (or) ;
  +	}
  +    else if (op == '~' && eq)
  +	{
  +	eq++ ;
  +	do 
  +	    {
  +	    or = strchr (eq + 1, '|') ;
  +	    e = or?or - 1:q - 1 ;
  +	    if (strstrn (sText, eq, e - eq))
  +		break ;
  +	    if (or == NULL)
  +		return 0 ;
  +	    eq = or + 1 ;
  +	    }
  +	while (or) ;
  +	}
  +    else if (op == '!' && pChildNode)
  +	{
  +	return 0 ;
  +	}
  +    else if (op == '*' && !pChildNode)
  +	{
  +	return 0 ;
  +	}
  +
  +    if (pChildNode && out && pChildNode -> xValue != 0)
  +	{
  +	if (pChildNode -> bFlags & aflgAttrChilds)
  +	    sText = Node_selfNodeName (Node_selfFirstChild (pDomTree, (tNodeData *)pChildNode))
;
  +        StringAdd (&pCode, sText, 0) ;
  +	}
  +    else
  +	; // mydie ("missing child") ;			    
  +
  +    return 1 ;
  +    }
  +
  +/* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* embperl_CompileToPerlCode                                                */
  +/*                                                                          */
   /* Compile one command inside a node                                        */
   /*                                                                          */
   /* ------------------------------------------------------------------------ */
  @@ -148,65 +320,46 @@
   	    q = strchr (p+1, '%') ;	
   	    if (q)
   		{
  -		if (p[1] == '#')
  -		    {
  -		    int nChildNo = atoi (&p[2]) ;
  -		    struct tNodeData * pChildNode = Node_selfNthChild (pDomTree, pNode, nChildNo) ;
  +		char  type  ;
  +		char  op  ;
  +		char  out = 1 ;
  +
  +		p++ ;
  +		type = *p ;
  +		p++ ;
  +		op = *p ;
  +		if (op != '=' && op != '*' && op != '!' && op != '~')
  +		    op = 0 ;
  +		else
  +		    p++ ;
   
  -		    if (pChildNode)
  -			StringAdd (&pCode, Node_selfNodeName(pChildNode), 0) ;
  -		    else
  -			; // mydie ("missing child") ;			    
  -		    }
  -		else if (p[1] == '$')
  +		if (*p == '-')
  +		    out = 0, p++ ;
  +
  +		
  +		if (type == '#')
   		    {
  -		    if (p[2] == 'n')
  +		    if (!embperl_CompileAddChildNode (pDomTree, pNode ,p, q, op, out))
   			{
  -			char s [20] ;
  -			int  l = sprintf (s, "$_ep_DomTree,%u", pNode -> xNdx) ;
  -			StringAdd (&pCode, s, l) ; 
  +			valid = 0 ;
  +			break ;
   			}
   		    }
  -		else
  +		else if (type == '&')
   		    {
  -		    const char * sVal ;
  -                    tAttrData *  pAttr ;
  -
  -		    if (p[1] == '=')
  -			{
  -                        const char * eq = strchr (p + 2, '=') ;
  -                        if (eq)
  -                            {
  -			    pAttr = Element_selfGetAttribut (pDomTree, pNode, p + 2, eq - p - 2) ;
  -			    if (strnicmp (p + 2, eq + 1, q - eq - 1) != 0)
  -			        {
  -			        valid = 0 ;
  -			        break ;
  -			        }
  -                            }
  -                        }
  -                    else if (p[1] == '!' || p[1] == '*')
  +		    if (!embperl_CompileAddAttribut (pDomTree, pNode ,p, q, op, out))
   			{
  -			pAttr = Element_selfGetAttribut (pDomTree, pNode, p + 2, q - p - 2) ;
  -			if ((pAttr && p[1] == '!') || (!pAttr && p[1] == '*') )
  -			    {
  -			    valid = 0 ;
  -			    break ;
  -			    }
  +			valid = 0 ;
  +			break ;
   			}
  -		    else
  -			pAttr = Element_selfGetAttribut (pDomTree, pNode, p + 1, q - p - 1) ;
  -		    
  -                    if (!pAttr || pAttr -> xValue == 0)
  -			sVal = NULL ;
  -		    else if (pAttr -> bFlags & aflgAttrValue)
  -                        sVal = Ndx2String (pAttr -> xValue) ;
  -                    else 
  -                        sVal = Node_selfNodeName (Node_selfFirstChild (pDomTree, (tNodeData
*)pAttr)) ;
  -
  -		    if (sVal)
  +		    }
  +		else if (type == '$')
  +		    {
  +		    if (*p == 'n')
   			{
  -			StringAdd (&pCode, sVal, 0) ; 
  +			char s [20] ;
  +			int  l = sprintf (s, "$_ep_DomTree,%u", pNode -> xNdx) ;
  +			StringAdd (&pCode, s, l) ; 
   			}
   		    }
   
  
  
  
  1.1.2.19  +58 -1     embperl/Attic/epdom.c
  
  Index: epdom.c
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epdom.c,v
  retrieving revision 1.1.2.18
  retrieving revision 1.1.2.19
  diff -u -r1.1.2.18 -r1.1.2.19
  --- epdom.c	2000/05/24 14:33:25	1.1.2.18
  +++ epdom.c	2000/05/26 23:31:05	1.1.2.19
  @@ -1277,7 +1277,7 @@
       struct tAttrData * pAttr = (struct tAttrData * )(pNode + 1) ;
       int  n = pNode -> numAttr ;
   
  -    while (n > 0 && nAttrName != pAttr -> xName)
  +    while (n > 0 && nAttrName != pAttr -> xName && pAttr -> bFlags)
   	{
   	n-- ;
   	pAttr++ ;
  @@ -1316,5 +1316,62 @@
       }
   
   
  +
  +
  +/* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* Element_selfSetAttribut                                                  */
  +/*                                                                          */
  +/* Set attribute value of Element by name                                   */
  +/*                                                                          */
  +/* ------------------------------------------------------------------------ */
  +
  +
  +
  +tAttrData *  Element_selfSetAttribut (/*in*/ tDomTree *	        pDomTree,
  +				      /*in*/ struct tNodeData * pNode,
  +				      /*in*/ const char *	sAttrName,
  +				      /*in*/ int		nAttrNameLen,
  +				      /*in*/ const char *       sNewValue, 
  +				      /*in*/ int		nNewValueLen)
  +
  +    {
  +    struct tAttrData * pAttr = Element_selfGetAttribut (pDomTree, pNode, sAttrName, nAttrNameLen)
;
  +    tNode xAttr ;
  +
  +    if (pAttr)
  +	{
  +	pAttr -> xValue = String2Ndx (sNewValue, nNewValueLen) ;
  +	return pAttr ;
  +	}
  +
  +    xAttr = Node_appendChild (pDomTree, ntypAttr, 0, sAttrName, nAttrNameLen, pNode ->
xNdx, 0) ;
  +    Node_appendChild (pDomTree, ntypAttrValue, 0, sNewValue, nNewValueLen, xAttr, 0) ;
  +    return (tAttrData *)Node_self(pDomTree, xAttr) ;
  +    }
  +
  +
  +/* ------------------------------------------------------------------------ */
  +/*                                                                          */
  +/* Element_selfRemoveAttribut                                               */
  +/*                                                                          */
  +/* Remove attribute of Element by name                                      */
  +/*                                                                          */
  +/* ------------------------------------------------------------------------ */
  +
  +
  +
  +tAttrData *  Element_selfRemoveAttribut (/*in*/ tDomTree *	        pDomTree,
  +				      /*in*/ struct tNodeData * pNode,
  +				      /*in*/ const char *	sAttrName,
  +				      /*in*/ int		nAttrNameLen)
  +
  +    {
  +    struct tAttrData * pAttr = Element_selfGetAttribut (pDomTree, pNode, sAttrName, nAttrNameLen)
;
  +
  +    if (pAttr)
  +	pAttr -> bFlags = 0 ;
  +    return pAttr ;
  +    }
   
   
  
  
  
  1.1.2.15  +14 -0     embperl/Attic/epdom.h
  
  Index: epdom.h
  ===================================================================
  RCS file: /home/cvs/embperl/Attic/epdom.h,v
  retrieving revision 1.1.2.14
  retrieving revision 1.1.2.15
  diff -u -r1.1.2.14 -r1.1.2.15
  --- epdom.h	2000/05/24 14:33:26	1.1.2.14
  +++ epdom.h	2000/05/26 23:31:06	1.1.2.15
  @@ -253,3 +253,17 @@
   			  	         /*in*/ struct tNodeData * pNode,
   				         /*in*/ int                n) ;
   
  +
  +tAttrData *  Element_selfSetAttribut (/*in*/ tDomTree *	        pDomTree,
  +				      /*in*/ struct tNodeData * pNode,
  +				      /*in*/ const char *	sAttrName,
  +				      /*in*/ int		nAttrNameLen,
  +				      /*in*/ const char *       sNewValue, 
  +				      /*in*/ int		nNewValueLen) ;
  +
  +
  +tAttrData *  Element_selfRemoveAttribut (/*in*/ tDomTree *	        pDomTree,
  +				      /*in*/ struct tNodeData * pNode,
  +				      /*in*/ const char *	sAttrName,
  +				      /*in*/ int		nAttrNameLen) ;
  +
  
  
  
  No                   revision
  
  
  No                   revision
  
  
  1.1.2.9   +29 -14    embperl/Embperl/Attic/Syntax.pm
  
  Index: Syntax.pm
  ===================================================================
  RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
  retrieving revision 1.1.2.8
  retrieving revision 1.1.2.9
  diff -u -r1.1.2.8 -r1.1.2.9
  --- Syntax.pm	2000/05/24 21:08:27	1.1.2.8
  +++ Syntax.pm	2000/05/26 23:31:09	1.1.2.9
  @@ -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.8 2000/05/24 21:08:27 richter Exp $
  +#   $Id: Syntax.pm,v 1.1.2.9 2000/05/26 23:31:09 richter Exp $
   #
   ###################################################################################
   
  @@ -48,6 +48,10 @@
                   {
                   $new -> {$k} = clonehash ($v, {}, $replace) ;
                   }
  +            elsif (ref ($v) eq 'ARRAY')
  +                {
  +                $new -> {$k} = [$v] ;
  +                }
               else
                   {
                   $new -> {$k} = $v ;
  @@ -80,7 +84,11 @@
           'unescape' => 1,
           'procinfo' => {
               embperl => { 
  -                    perlcode => '_ep_rp(%$n%,scalar(do{%#0%}));', 
  +                    perlcode => 
  +                        [
  +                        'if (!defined (_ep_rp(%$n%,scalar(do{%#~0:$row|$col|$cnt%}))))
{ last ; }',
  +                        '_ep_rp(%$n%,scalar(do{%#0%}));', 
  +                        ],
                       removenode  => 4,
                       }
               },
  @@ -91,7 +99,10 @@
           'unescape' => 1,
           'procinfo' => {
               embperl => { 
  -                        perlcode    => '{%#0%;}',
  +                        perlcode    => [
  +                                'if (!defined (scalar (do {%#~0:$row|$col|$cnt%}))) { last
; }',
  +                                '{%#0%;}',
  +                                ],
                           removenode  => 3,
                           mayjump     => 1,
                           },
  @@ -133,7 +144,12 @@
   clonehash (\%Cmds, \%CmdsLink, { 'unescape' => 2 }) ;
   
   $CmdsLink{'Embperl output code'}{'nodename'} = '[+url' ;
  -$CmdsLink{'Embperl output code'}{'procinfo'}{'embperl'}{'perlcode'} = '_ep_rpurl(%$n%,scalar(do{%#0%}));'
;
  +$CmdsLink{'Embperl output code'}{'procinfo'}{'embperl'}{'perlcode'} = 
  +                        [
  +                        'if (!defined (_ep_rpurl(%$n%,scalar(do{%#~0:$row|$col|$cnt%}))))
{ last ; }',
  +                        '_ep_rpurl(%$n%,scalar(do{%#0%}));', 
  +                        ] ;
  +
   
   
   
  @@ -223,10 +239,9 @@
               embperl => { 
                   perlcode =>
                       [ 
  -                    'HTML::Embperl::Cmd::InputCheck (%$n%, \'%*name%\', \'%*value%\') ;
 %=type=radio% ',
  -                    'HTML::Embperl::Cmd::InputCheck (%$n%, \'%*name%\', \'%*value%\') ;
 %=type=checkbox% ',
  -                    '$idat{\'%*name%\'} = \'%*value%\' ; ',
  -                    'HTML::Embperl::Cmd::InputText (%$n%, \'%*name%\') ;   %!value%',
  +                    'if ($fdat{\'%&*name%\'} eq \'%&*value%\') { HTML::Embperl::Node::Element_setAttribut
(%$n%, \'checked\', undef) } else {HTML::Embperl::Node::Element_removeAttribut (%$n%, \'checked\')
};  %&=type:radio|checkbox% ',
  +                    'HTML::Embperl::Node::Element_setAttribut (%$n%, \'value\', $fdat{\'%&*name%\'})
;   %&!value%',
  +                    '$idat{\'%&*name%\'} = \'%&*value%\' ; ',
                       ]
                   }                     
               },
  @@ -348,7 +363,7 @@
           'endtag'   => 'endif',
           'procinfo' => {
               embperl => { 
  -                perlcode => 'if (%<noname>%) { ', 
  +                perlcode => 'if (%&<noname>%) { ', 
                   perlcodeend => '}',
                   removenode => 10,
                   mayjump     => 1,
  @@ -381,7 +396,7 @@
           'endtag'   => 'endif',
           'procinfo' => {
               embperl => { 
  -                perlcode => 'elsif (%<noname>%) { ', 
  +                perlcode => 'elsif (%&<noname>%) { ', 
                   perlcodeend => '}',
                   removenode => 10,
                   mayjump     => 1,
  @@ -396,7 +411,7 @@
           'endtag'   => 'endwhile',
           'procinfo' => {
               embperl => { 
  -                perlcode => 'while (%<noname>%) { ', 
  +                perlcode => 'while (%&<noname>%) { ', 
                   perlcodeend => '}',
                   removenode => 10,
                   mayjump     => 1,
  @@ -415,7 +430,7 @@
           'endtag'   => 'endforeach',
           'procinfo' => {
               embperl => { 
  -                perlcode => 'foreach %<noname>% { ', 
  +                perlcode => 'foreach %&<noname>% { ', 
                   perlcodeend => '}',
                   removenode => 10,
                   mayjump     => 1,
  @@ -434,7 +449,7 @@
           'procinfo' => {
               embperl => { 
                   perlcode => 'do { ', 
  -                perlcodeend => '} until (%<noname>%) ; ',
  +                perlcodeend => '} until (%&<noname>%) ; ',
                   removenode => 10,
                   mayjump     => 1,
                   }
  @@ -452,7 +467,7 @@
           'unescape' => 1,
           'procinfo' => {
               embperl => { 
  -                perlcode => 'use strict ; use vars qw {%<noname>%} ;', 
  +                perlcode => 'use strict ; use vars qw {%&<noname>%} ;', 
                   removenode => 3,
                   }
               },
  
  
  

Mime
View raw message