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...@apache.org on 2001/08/28 10:01:28 UTC
cvs commit: embperl/Embperl/Syntax EmbperlBlocks.pm RTF.pm
richter 01/08/28 01:01:28
Modified: . Tag: Embperl2c Embperl.pm epcomp.c epdom.c
epparse.c eputil.c
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c EmbperlBlocks.pm RTF.pm
Log:
Embperl 2 - RTF syntax und parser/compiler bugfixes
Revision Changes Path
No revision
No revision
1.118.4.49 +2 -2 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.48
retrieving revision 1.118.4.49
diff -u -r1.118.4.48 -r1.118.4.49
--- Embperl.pm 2001/07/25 04:03:12 1.118.4.48
+++ Embperl.pm 2001/08/28 08:01:26 1.118.4.49
@@ -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.118.4.48 2001/07/25 04:03:12 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.49 2001/08/28 08:01:26 richter Exp $
#
###################################################################################
@@ -68,7 +68,7 @@
##ep2##
-$VERSION = '2.0b4_dev' ;
+$VERSION = '2.0b4_dev-2' ;
##/ep2##
##ep1##$VERSION = '1.3.4_dev';
1.4.2.55 +20 -16 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.54
retrieving revision 1.4.2.55
diff -u -r1.4.2.54 -r1.4.2.55
--- epcomp.c 2001/07/31 08:02:07 1.4.2.54
+++ epcomp.c 2001/08/28 08:01:26 1.4.2.55
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcomp.c,v 1.4.2.54 2001/07/31 08:02:07 richter Exp $
+# $Id: epcomp.c,v 1.4.2.55 2001/08/28 08:01:26 richter Exp $
#
###################################################################################*/
@@ -1129,8 +1129,8 @@
int i ;
char * pCode = NULL ;
char * pCTCode = NULL ;
- SV * args[4] ;
- int nCodeLen = 0 ;
+ SV * args[4] ;
+ STRLEN nCodeLen = 0 ;
if (pCmd -> nNodeType != pNode -> nType)
@@ -1179,22 +1179,24 @@
{
if (SvOK (r -> pCodeSV))
{
- STRLEN l ;
- char * p = SvPV (r -> pCodeSV, l) ;
- StringAdd (r -> pProg, p, l ) ;
- StringAdd (r -> pProg, "\n", 1) ;
- if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CodeEnd: %s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, p) ;
+ char * p = SvPV (r -> pCodeSV, nCodeLen) ;
+ if (nCodeLen)
+ {
+ StringAdd (r -> pProg, p, nCodeLen ) ;
+ StringAdd (r -> pProg, "\n", 1) ;
+ if (pCurrReq -> bDebug & dbgParse)
+ lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CodeEnd: %s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, p) ;
+ }
}
}
- else if (pCode)
+ else if (pCode && nCodeLen)
{
StringAdd (r -> pProg, pCode, nCodeLen ) ;
StringAdd (r -> pProg, "\n", 1) ;
if (pCurrReq -> bDebug & dbgParse)
lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CodeEnd: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, nCodeLen, nCodeLen, pCode) ;
}
- else
+ if (nCodeLen == 0)
{
if (pCmd -> bPerlCodeRemove && nStartCodeOffset)
{
@@ -1280,11 +1282,6 @@
int nCheckpointCodeOffset = 0 ;
tEmbperlCompilerInfo * pInfo = (tEmbperlCompilerInfo *)(*(void * *)r -> pTokenTable) ;
-
- if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d -------> parent=%d node=%d type=%d text=%s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, Node_parentNode (pDomTree, pNode -> xNdx), pNode -> xNdx,
- pNode -> nType, Node_selfNodeName(pNode)) ;
-
pCmd = NULL ;
nNdx = Node_selfNodeNameNdx (pNode) ;
@@ -1297,6 +1294,13 @@
}
else
pCmd = pCmdHead = NULL ;
+
+
+ if (pCurrReq -> bDebug & dbgParse)
+ lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d -------> parent=%d node=%d type=%d text=%s (#%d,%s)\n",
+ pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber,
+ Node_parentNode (pDomTree, pNode -> xNdx), pNode -> xNdx,
+ pNode -> nType, Node_selfNodeName(pNode), nNdx, pCmd?"compile":"-") ;
if (pCmd == NULL || (pCmd -> bRemoveNode & 1) == 0)
1.4.2.43 +6 -6 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.42
retrieving revision 1.4.2.43
diff -u -r1.4.2.42 -r1.4.2.43
--- epdom.c 2001/08/01 08:02:36 1.4.2.42
+++ epdom.c 2001/08/28 08:01:26 1.4.2.43
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdom.c,v 1.4.2.42 2001/08/01 08:02:36 richter Exp $
+# $Id: epdom.c,v 1.4.2.43 2001/08/28 08:01:26 richter Exp $
#
###################################################################################*/
@@ -1475,7 +1475,7 @@
if (pCurrReq -> bDebug & dbgParse)
lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s Attribut parent=%d node=%d type=%d text=%*.*s (#%d) %s\n",
- pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, xNdx, nType, nTextLen, nTextLen, sText?sText:Ndx2String (nTextLen), sText?String2NdxNoInc (sText, nTextLen):nTextLen, sLogMsg?sLogMsg:"") ;
+ pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, xNdx, nType, sText?nTextLen:0, sText?nTextLen:1000, sText?sText:Ndx2String (nTextLen), sText?String2NdxNoInc (sText, nTextLen):nTextLen, sLogMsg?sLogMsg:"") ;
return xNdx ;
}
@@ -1530,8 +1530,8 @@
pNew -> xValue = sText?String2NdxNoInc (sText, nTextLen):nTextLen ;
NdxStringRefcntInc (pNew -> xValue) ;
if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s AttributValue parent=%d node=%d type=%d text=%*.*s (#%d) %s\n", pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, pNew -> xNdx, nType, nTextLen, nTextLen,
- sText?sText:"<null>", sText?String2NdxNoInc (sText, nTextLen):-1, sLogMsg?sLogMsg:"") ;
+ lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s AttributValue parent=%d node=%d type=%d text=%*.*s (#%d) %s\n", pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, pNew -> xNdx, nType,
+ sText?nTextLen:0, sText?nTextLen:1000, sText?sText:Ndx2String (nTextLen), sText?String2NdxNoInc (sText, nTextLen):nTextLen, sLogMsg?sLogMsg:"") ;
pNew -> bFlags |= aflgAttrValue ;
return xParent ;
@@ -1584,8 +1584,8 @@
pNew -> nText = xText ;
if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s Element parent=%d node=%d type=%d text=%*.*s (#%d) %s\n", pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, pNew -> xNdx, nType, nTextLen, nTextLen, sText?sText:"<null>",
- sText?String2NdxNoInc (sText, nTextLen):-1, sLogMsg?sLogMsg:"") ;
+ lprintf (pCurrReq, "[%d]PARSE: AddNode: +%02d %*s Element parent=%d node=%d type=%d text=%*.*s (#%d) %s\n", pCurrReq -> nPid, nLevel, nLevel * 2, "", xParent, pNew -> xNdx, nType,
+ sText?nTextLen:0, sText?nTextLen:1000, sText?sText:Ndx2String (nTextLen), sText?String2NdxNoInc (sText, nTextLen):nTextLen, sLogMsg?sLogMsg:"") ;
return pNew -> xNdx ;
}
1.4.2.32 +5 -6 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.31
retrieving revision 1.4.2.32
diff -u -r1.4.2.31 -r1.4.2.32
--- epparse.c 2001/08/01 08:02:36 1.4.2.31
+++ epparse.c 2001/08/28 08:01:27 1.4.2.32
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epparse.c,v 1.4.2.31 2001/08/01 08:02:36 richter Exp $
+# $Id: epparse.c,v 1.4.2.32 2001/08/28 08:01:27 richter Exp $
#
###################################################################################*/
@@ -107,7 +107,6 @@
sprintf (r -> errdat2, "%s => procinfo", pToken -> sText) ;
return rcNotHashRef ;
}
-
if (strcmp (pKey, "embperl") == 0)
embperl_CompileInitItem (r, (HV *)(SvRV (pSVValue)), pToken -> nNodeName, pToken -> nNodeType, 1, ppCompilerInfo) ;
else if (strncmp (pKey, "embperl#", 8) == 0 && (n = atoi (pKey+8)) > 0)
@@ -348,13 +347,13 @@
if (p -> sNodeName)
{
- if (p -> sNodeName[0] == '!')
- p -> nNodeName = String2Ndx (p -> sNodeName + 1, strlen (p -> sNodeName + 1)) ;
+ if (p -> sNodeName[0] != '!')
+ p -> nNodeName = String2Ndx (p -> sNodeName, strlen (p -> sNodeName)) ;
else
- p -> nNodeName = String2UniqueNdx (p -> sNodeName, strlen (p -> sNodeName)) ;
+ p -> nNodeName = String2UniqueNdx (p -> sNodeName + 1, strlen (p -> sNodeName + 1)) ;
}
else
- p -> nNodeName = String2UniqueNdx (p -> sText, strlen (p -> sText)) ;
+ p -> nNodeName = String2Ndx (p -> sText, strlen (p -> sText)) ;
if ((rc = CheckProcInfo (r, pHash, p, ppCompilerInfo)) != ok)
1.15.4.13 +5 -5 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.12
retrieving revision 1.15.4.13
diff -u -r1.15.4.12 -r1.15.4.13
--- eputil.c 2001/06/25 03:30:05 1.15.4.12
+++ eputil.c 2001/08/28 08:01:27 1.15.4.13
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.15.4.12 2001/06/25 03:30:05 richter Exp $
+# $Id: eputil.c,v 1.15.4.13 2001/08/28 08:01:27 richter Exp $
#
###################################################################################*/
@@ -1037,10 +1037,10 @@
(void)hv_iterinit(symtab);
while ((val = hv_iternextsv(symtab, &key, &klen)))
{
- if(SvTYPE(val) != SVt_PVGV)
+ if(SvTYPE(val) != SVt_PVGV || SvANY(val) == NULL)
{
if (bDebug)
- lprintf (r, "[%d]CUP: Ignore ??? because it's no gv\n", r -> nPid) ;
+ lprintf (r, "[%d]CUP: Ignore %s because it's no gv\n", r -> nPid, key) ;
continue;
}
@@ -1087,7 +1087,7 @@
sObjName = NULL ;
- lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE (GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ;
+ /* lprintf (r, "[%d]CUP: type = %d flags=%x\n", r -> nPid, SvTYPE (GvSV((GV*)val)), SvFLAGS (GvSV((GV*)val))) ; */
if((sv = GvSV((GV*)val)) && SvTYPE (sv) == SVt_PVMG)
{
HV * pStash = SvSTASH (sv) ;
@@ -1110,7 +1110,7 @@
if((sv = GvSV((GV*)val)) && SvROK (sv) && SvOBJECT (SvRV(sv)))
{
HV * pStash = SvSTASH (SvRV(sv)) ;
- lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE (SvRV(GvSV((GV*)val)))) ;
+ /* lprintf (r, "[%d]CUP: rv type = %d\n", r -> nPid, SvTYPE (SvRV(GvSV((GV*)val)))) ;*/
if (pStash)
{
sObjName = HvNAME(pStash) ;
No revision
No revision
1.1.4.41 +5 -3 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.40
retrieving revision 1.1.4.41
diff -u -r1.1.4.40 -r1.1.4.41
--- Syntax.pm 2001/07/31 08:02:09 1.1.4.40
+++ Syntax.pm 2001/08/28 08:01:28 1.1.4.41
@@ -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.4.40 2001/07/31 08:02:09 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.41 2001/08/28 08:01:28 richter Exp $
#
###################################################################################
@@ -317,7 +317,7 @@
# The document node is generated always and is not parserd, but can be used to include code
'Document' => {
- 'nodename' => '!Document',
+ 'nodename' => 'Document',
'nodetype' => ntypDocument,
'procinfo' => {
embperl => {
@@ -348,7 +348,7 @@
},
# The document fraq node is generated always and is not parserd, but can be used to include code
'DocumentFraq' => {
- 'nodename' => '!DocumentFraq',
+ 'nodename' => 'DocumentFraq',
'nodetype' => ntypDocumentFraq,
'procinfo' => {
embperl => {
@@ -564,6 +564,8 @@
Text that should be outputed when node is stringifyed. Defaults to text.
If the first character is a ':' you can specify the sourounding delimiters for this
tag with :<start>:<end>:<text>:<endtag>. Example: ':{:}:NAME' .
+If the nodename starts with a '!' a unique internal id is generated, so two or more
+nodename of the same text, can have different meaning in different contexts.
=item 'contains' => 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789'
No revision
No revision
1.1.2.17 +2 -2 embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm
Index: EmbperlBlocks.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm,v
retrieving revision 1.1.2.16
retrieving revision 1.1.2.17
diff -u -r1.1.2.16 -r1.1.2.17
--- EmbperlBlocks.pm 2001/04/27 06:33:21 1.1.2.16
+++ EmbperlBlocks.pm 2001/08/28 08:01:28 1.1.2.17
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlBlocks.pm,v 1.1.2.16 2001/04/27 06:33:21 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.17 2001/08/28 08:01:28 richter Exp $
#
###################################################################################
@@ -98,7 +98,7 @@
'unescape' => 2,
(ref($taginfo) eq 'HASH'?%$taginfo:()),
} ;
- $tag -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } if ($procinfo) ;
+ $tag2 -> {'procinfo'} = { $self -> {-procinfotype} => $procinfo } if ($procinfo) ;
return $tag ;
}
1.1.2.15 +58 -16 embperl/Embperl/Syntax/Attic/RTF.pm
Index: RTF.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/RTF.pm,v
retrieving revision 1.1.2.14
retrieving revision 1.1.2.15
diff -u -r1.1.2.14 -r1.1.2.15
--- RTF.pm 2001/08/01 14:02:38 1.1.2.14
+++ RTF.pm 2001/08/28 08:01:28 1.1.2.15
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: RTF.pm,v 1.1.2.14 2001/08/01 14:02:38 richter Exp $
+# $Id: RTF.pm,v 1.1.2.15 2001/08/28 08:01:28 richter Exp $
#
###################################################################################
@@ -229,7 +229,7 @@
$self -> AddRTFCmd ('IF',
{
perlcode => '$_ep_rtf_tmp = \'\';',
- compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '# test if' ; ],
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '_ep_rp($x, \'{\'.($_ep_rtf_tmp $op $cmp?$a:$b).\'}\');' ; ],
},
{
'nodename' => '::::IF',
@@ -238,6 +238,29 @@
},
) ;
+ $self -> AddRTFCmd ('NEXTIF',
+ {
+ perlcode => '$_ep_rtf_tmp = \'\';',
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx++ if ($_ep_rtf_tmp $op $cmp); ' ; ],
+ },
+ {
+ 'nodename' => '::::NEXTIF',
+ 'removenode' => 1,
+ 'cdatatype' => 0,
+ },
+ ) ;
+
+ $self -> AddRTFCmd ('SKIPIF',
+ {
+ perlcode => '$_ep_rtf_tmp = \'\';',
+ compiletimeperlcode => q[$_ep_rtf_inside = 1 ; $_ep_rtf_code = '$_ep_rtf_ndx+=2 if ($_ep_rtf_tmp $op $cmp); ' ; ],
+ },
+ {
+ 'nodename' => '::::NEXTIF',
+ 'removenode' => 1,
+ 'cdatatype' => 0,
+ },
+ ) ;
=pod
@@ -414,14 +437,14 @@
'removespaces' => 2,
#'cdatatype' => ntypCDATA,
#'cdatatype' => ntypAttrValue,
- 'nodename' => ':',
+ 'nodename' => '!:',
'inside' => {},
'procinfo' => {'embperl' => {}},
},
'RTF field' => {
'text' => '{\field',
'end' => '}',
- 'nodename' => ':{:::}',
+ 'nodename' => '!:{:::}',
'nodetype' => ntypStartEndTag,
'insidemustexist' => 1,
'inside' => \%FieldStart,
@@ -441,7 +464,7 @@
'RTF block inside' => {
'text' => '{',
'end' => '}',
- 'nodename' => ':{:::}',
+ 'nodename' => '!:{:::}',
'nodetype' => ntypStartEndTag,
'cdatatype' => ntypCDATA,
'removespaces' => 0,
@@ -450,7 +473,7 @@
'RTF fieldstart' => {
'text' => '{\*\fldinst',
'end' => '}',
- 'nodename' => ':',
+ 'nodename' => '!:',
'nodetype' => ntypStartEndTag,
#'cdatatype' => ntypCDATA,
#'cdatatype' => ntypAttrValue,
@@ -460,7 +483,7 @@
'RTF fieldend' => {
'text' => '{\fldrslt',
'end' => '}',
- 'nodename' => '',
+ 'nodename' => '!',
'cdatatype' => ntypAttrValue,
'inside' => \%BlockInside,
},
@@ -474,7 +497,7 @@
'RTF first paragraph' => {
'text' => '\pard',
'end' => '}',
- 'nodename' => ':::\pard:}',
+ 'nodename' => '!:::\pard:}',
'nodetype' => ntypStartTag,
'inside' => \%Block,
'procinfo' => {
@@ -488,7 +511,7 @@
'RTF field' => {
'text' => '{\field',
'end' => '}',
- 'nodename' => ':{:::}',
+ 'nodename' => '!:{:::}',
'nodetype' => ntypStartEndTag,
#'cdatatype' => ntypAttrValue,
'insidemustexist' => 1,
@@ -508,7 +531,7 @@
# 'RTF block' => {
# 'text' => '{',
# 'end' => '}',
-# 'nodename' => ':{:}:',
+# 'nodename' => '!:{:}:',
# 'cdatatype' => ntypAttrValue,
# #'forcetype' => ntypAttrValue,
# 'removespaces' => 0,
@@ -517,7 +540,7 @@
'RTF block' => {
'text' => '{',
'end' => '}',
- 'nodename' => ':{:::}',
+ 'nodename' => '!:{:::}',
'nodetype' => ntypStartEndTag,
'cdatatype' => ntypCDATA,
'removespaces' => 0,
@@ -526,24 +549,43 @@
'RTF field' => {
'text' => '{\field',
'end' => '}',
- 'nodename' => ':{:::}',
+ 'nodename' => '!:{:::}',
'nodetype' => ntypStartEndTag,
'insidemustexist' => 1,
'inside' => \%FieldStart,
'procinfo' => {
'embperl' => {
compiletimeperlcode => q[$_ep_rtf_inside++ if ($_ep_rtf_inside) ; ],
+ perlcodeend => '%$x%',
compiletimeperlcodeend => q[
if ($_ep_rtf_inside)
{
$_ep_rtf_inside-- ;
if ($_ep_rtf_inside == 0)
{
- my ($op, $cmp, $a, $b) = XML::Embperl::DOM::Node::iChildsText (%$q%,%$x%,1) =~ /\:([=<>])\s*\"(.*?)\"\s*\"(.*?)\"\s*\"(.*?)\"/ ;
- #print "op = $op cmp = $cmp a = $a b = $b\n" ;
+ my $x = $_[0] -> Code ;
+ my ($op, $cmp, $a, $b) = XML::Embperl::DOM::Node::iChildsText (%$q%,%$x%,1) =~ /\:([=<>])+\s*\"(.*?)\"(?:\s*\"(.*?)\"\s*\"(.*?)\")?/ ;
+ if ($op eq '=') { $op = 'eq' }
+ elsif ($op eq '<') { $op = 'lt' }
+ elsif ($op eq '>') { $op = 'gt' }
+ elsif ($op eq '>=') { $op = 'ge' }
+ elsif ($op eq '<=') { $op = 'le' }
+
+ #print "op = $op cmp = $cmp a = $a b = $b code=$_ep_rtf_code tmp=$_ep_rtf_tmp 0=$param[0]{'adressen_anrede'} ndx=$_ep_rtf_ndx eval=qq[$_ep_rtf_code]\n" ;
+ $_ep_rtf_code =~ s/\$a/q\[$a\]/g ;
+ $_ep_rtf_code =~ s/\$b/q\[$b\]/g ;
+ $_ep_rtf_code =~ s/\$cmp/q\[$cmp\]/g ;
+ $_ep_rtf_code =~ s/\$op/$op/g ;
+ $_ep_rtf_code =~ s/\$x/$x/g ;
+ #print "result=$_ep_rtf_code\n" ;
+
$_[0] -> Code ($_ep_rtf_code) ;
- }
+ }
}
+ else
+ {
+ $_[0] -> Code ('') ;
+ }
],
},
},
@@ -568,7 +610,7 @@
'RTF block' => {
'text' => '{',
'end' => '}',
- 'nodename' => '',
+ 'nodename' => '!',
'cdatatype' => ntypAttrValue,
'inside' => \%BlockInside,
},
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org