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,
}
},
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
