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/06/27 07:31:48 UTC
cvs commit: embperl/test/html escape.htm
richter 00/06/26 22:31:47
Modified: . Tag: Embperl2 Changes.pod Embperl.xs ep.h epcmd2.c
epcomp.c epdom.c test.pl
test/cmp Tag: Embperl2 errormismatch.htm
errormismatchcmd.htm escape.htm
test/html Tag: Embperl2 escape.htm
Log:
Embperl 2 - Memory Management
Revision Changes Path
No revision
No revision
1.115.2.10 +3 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.115.2.9
retrieving revision 1.115.2.10
diff -u -r1.115.2.9 -r1.115.2.10
--- Changes.pod 2000/06/18 19:27:53 1.115.2.9
+++ Changes.pod 2000/06/27 05:31:35 1.115.2.10
@@ -41,6 +41,9 @@
- [* *] blocks works now as expected.
- option tag can take value optional from html text, so
<option value="foo"> and <option>foo</option> are the same
+ - Embperl now converts not only array ref, but also hashs refs
+ (e.g. href="[+ { a => 1, b => 2, c => 3 } +]") inside a url
+ to a=1&b=2&c=3.
=head1 1.3b4_dev -- That's what currently under developement
1.26.2.22 +2 -40 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.26.2.21
retrieving revision 1.26.2.22
diff -u -r1.26.2.21 -r1.26.2.22
--- Embperl.xs 2000/06/26 05:00:24 1.26.2.21
+++ Embperl.xs 2000/06/27 05:31:36 1.26.2.22
@@ -676,47 +676,9 @@
int xOldChild
SV * sText
PPCODE:
- STRLEN l ;
- char * s ;
- AV * pAV ;
- tDomTree * pDomTree = DomTree_self(xDomTree) ;
+ SV * sRet = Node_replaceChildWithUrlDATA (xDomTree, xOldChild,sText) ;
- if (SvTYPE(sText) == SVt_RV && SvTYPE((pAV = (AV *)SvRV(sText))) == SVt_PVAV)
- { /* Array reference inside URL */
- SV ** ppSV ;
- int i ;
- int f = AvFILL(pAV) ;
- tNode xNode ;
-
- Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, "", 0, 4, nflgModified | nflgReturn) ;
-
- for (i = 0; i <= f; i++)
- {
- ppSV = av_fetch (pAV, i, 0) ;
- if (ppSV && *ppSV)
- {
- s = SV2String (*ppSV, l) ;
- xNode = Node_appendChild (pDomTree, ntypText, 0, s, l, xOldChild, 0, 0) ;
- if (pCurrReq -> nCurrEscMode & 2)
- Node_self (pDomTree, xNode) -> bFlags |= nflgEscUrl ;
- }
- if ((i & 1) == 0)
- Node_appendChild (pDomTree, ntypCDATA, 0, "=", 1, xOldChild, 0, 0) ;
- else if (i < f)
- Node_appendChild (pDomTree, ntypCDATA, 0, "&", 1, xOldChild, 0, 0) ;
- }
-
- }
- else
- {
- char * s = SV2String (sText, l) ;
- Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, s, l, (pCurrReq -> nCurrEscMode & 3) == 3?2 + (pCurrReq -> nCurrEscMode & 4):pCurrReq -> nCurrEscMode, nflgModified | nflgReturn) ;
- }
-
- pCurrReq -> nCurrEscMode = pCurrReq -> nEscMode ;
- pCurrReq -> bEscModeSet = -1 ;
- SvREFCNT_inc (sText) ;
- /* ST(0) = sText ;*/
+ ST(0) = sRet ;
XSRETURN(1) ;
1.23.2.10 +7 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.23.2.9
retrieving revision 1.23.2.10
diff -u -r1.23.2.9 -r1.23.2.10
--- ep.h 2000/06/18 19:27:53 1.23.2.9
+++ ep.h 2000/06/27 05:31:36 1.23.2.10
@@ -403,6 +403,13 @@
/*in*/ tNode xNode,
/*in*/ const char * sArg) ;
+
+SV * Node_replaceChildWithUrlDATA (/*in*/ tIndex xDomTree,
+ tIndex xOldChild,
+ SV * sText) ;
+
+
+
/* ---- from eputil.c ----- */
1.1.2.8 +96 -0 embperl/Attic/epcmd2.c
Index: epcmd2.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcmd2.c,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- epcmd2.c 2000/06/11 18:58:15 1.1.2.7
+++ epcmd2.c 2000/06/27 05:31:37 1.1.2.8
@@ -279,3 +279,99 @@
return ok ;
}
+
+
+
+
+/* ---------------------------------------------------------------------------- */
+/* */
+/* ouput data inside a url */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+
+SV * Node_replaceChildWithUrlDATA (/*in*/ tIndex xDomTree,
+ tIndex xOldChild,
+ SV * sText)
+
+ {
+ STRLEN l ;
+ char * s ;
+ AV * pAV ;
+ HV * pHV ;
+ tDomTree * pDomTree = DomTree_self(xDomTree) ;
+
+ if (SvTYPE(sText) == SVt_RV && SvTYPE((pAV = (AV *)SvRV(sText))) == SVt_PVAV)
+ { /* Array reference inside URL */
+ SV ** ppSV ;
+ int i ;
+ int f = AvFILL(pAV) ;
+ tNode xNode ;
+
+ xOldChild = Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, "", 0, 4, nflgModified | nflgReturn) ;
+
+ for (i = 0; i <= f; i++)
+ {
+ ppSV = av_fetch (pAV, i, 0) ;
+ if (ppSV && *ppSV)
+ {
+ s = SV2String (*ppSV, l) ;
+ xNode = Node_appendChild (pDomTree, ntypText, 0, s, l, xOldChild, 0, 0) ;
+ if (pCurrReq -> nCurrEscMode & 2)
+ Node_self (pDomTree, xNode) -> bFlags |= nflgEscUrl ;
+ }
+ if ((i & 1) == 0)
+ Node_appendChild (pDomTree, ntypCDATA, 0, "=", 1, xOldChild, 0, 0) ;
+ else if (i < f)
+ Node_appendChild (pDomTree, ntypCDATA, 0, "&", 1, xOldChild, 0, 0) ;
+ }
+
+ }
+
+ else if (SvTYPE(sText) == SVt_RV && SvTYPE((pHV = (HV *)SvRV(sText))) == SVt_PVHV)
+ { /* Hash reference inside URL */
+ SV ** ppSV ;
+ HE * pEntry ;
+ char * pKey ;
+ SV * pSVValue ;
+ tNode xNode ;
+ int i = 0 ;
+
+ xOldChild = Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, "", 0, 4, nflgModified | nflgReturn) ;
+
+ hv_iterinit (pHV) ;
+ while (pEntry = hv_iternext (pHV))
+ {
+ if (i++ > 0)
+ Node_appendChild (pDomTree, ntypCDATA, 0, "&", 1, xOldChild, 0, 0) ;
+ pKey = hv_iterkey (pEntry, &l) ;
+ xNode = Node_appendChild (pDomTree, ntypText, 0, pKey, l, xOldChild, 0, 0) ;
+ if (pCurrReq -> nCurrEscMode & 2)
+ Node_self (pDomTree, xNode) -> bFlags |= nflgEscUrl ;
+
+ Node_appendChild (pDomTree, ntypCDATA, 0, "=", 1, xOldChild, 0, 0) ;
+
+ pSVValue = hv_iterval (pHV , pEntry) ;
+ if (pSVValue)
+ {
+ s = SV2String (pSVValue, l) ;
+ xNode = Node_appendChild (pDomTree, ntypText, 0, s, l, xOldChild, 0, 0) ;
+ if (pCurrReq -> nCurrEscMode & 2)
+ Node_self (pDomTree, xNode) -> bFlags |= nflgEscUrl ;
+ }
+ }
+ }
+ else
+ {
+ char * s = SV2String (sText, l) ;
+ Node_replaceChildWithCDATA (DomTree_self(xDomTree), -1, xOldChild, s, l, (pCurrReq -> nCurrEscMode & 3) == 3?2 + (pCurrReq -> nCurrEscMode & 4):pCurrReq -> nCurrEscMode, nflgModified | nflgReturn) ;
+ }
+
+ pCurrReq -> nCurrEscMode = pCurrReq -> nEscMode ;
+ pCurrReq -> bEscModeSet = -1 ;
+ /* SvREFCNT_inc (sText) ; */
+ /* ST(0) = sText ;*/
+ /* XSRETURN(1) ; */
+ return sText ;
+ }
+
1.1.2.37 +54 -5 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.1.2.36
retrieving revision 1.1.2.37
diff -u -r1.1.2.36 -r1.1.2.37
--- epcomp.c 2000/06/25 19:49:11 1.1.2.36
+++ epcomp.c 2000/06/27 05:31:37 1.1.2.37
@@ -990,7 +990,9 @@
clock_t cl3 ;
clock_t cl4 ;
int bCheckpointPending = 0 ;
+ STRLEN l ;
+
tainted = 0 ;
/* Already Parsed ? */
@@ -1000,16 +1002,47 @@
if (*ppSV != NULL && SvTYPE (*ppSV) == SVt_PV)
{
- strncpy (r -> errdat1, SvPV(*ppSV, na), sizeof (r -> errdat1) - 1) ;
+ strncpy (r -> errdat1, SvPV(*ppSV, l), sizeof (r -> errdat1) - 1) ;
LogError (r, rcEvalErr) ;
return rcEvalErr ;
}
+ else if (*ppSV != NULL && SvTYPE (*ppSV) == SVt_PVIV)
+ {
+ char * s1 = SvPV(*ppSV, l) ;
+ char * s2 = strchr (s1, '\t') ;
+ int l1 ;
+ if (s2)
+ {
+ l1 = s2 - s1 ;
+ if (l1 > sizeof (r -> errdat1) - 1)
+ l1 = sizeof (r -> errdat1) - 1 ;
+
+ strncpy (r -> errdat1, s1, l1) ;
+ r -> errdat1[l1] = '\0' ;
+ strncpy (r -> errdat2, s2+1, sizeof (r -> errdat2) - 1) ;
+ }
+ else
+ strncpy (r -> errdat1, s1, sizeof (r -> errdat1) - 1) ;
- /* lprintf (r, "ppSV=%s type=%d\n", *ppSV?"ok":"NULL", *ppSV?SvTYPE (*ppSV):-1) ; */
- if (*ppSV == NULL || SvTYPE (*ppSV) != SVt_IV)
+ r -> Buf.pCurrPos = NULL ;
+ r -> Buf.nSourceline = 0 ;
+ return SvIVX(*ppSV) ;
+ }
+ else if (*ppSV == NULL || SvTYPE (*ppSV) != SVt_IV)
{
if ((rc = ParseFile (r)) != ok)
+ {
+ *ppSV = newSVpvf ("%s\t%s", r -> errdat1, r -> errdat2) ;
+ SvUPGRADE (*ppSV, SVt_PVIV) ;
+ SvIVX (*ppSV) = rc ;
+ if (r -> xCurrDomTree)
+ {
+ DomTree_delete(DomTree_self(r -> xCurrDomTree)) ;
+ r -> xCurrDomTree = 0 ;
+ }
+
return rc ;
+ }
cl2 = clock () ;
@@ -1027,7 +1060,19 @@
nLabelCnt = 1 ;
if ((rc = embperl_CompileNode (pDomTree, r -> xDocument, &bCheckpointPending)) != ok)
+ {
+ *ppSV = newSVpvf ("%s\t%s", r -> errdat1, r -> errdat2) ;
+ SvUPGRADE (*ppSV, SVt_PVIV) ;
+ SvIVX (*ppSV) = rc ;
+ if (r -> xCurrDomTree)
+ {
+ DomTree_delete(DomTree_self(r -> xCurrDomTree)) ;
+ r -> xCurrDomTree = 0 ;
+ }
+ StringFree (&pProg) ;
+
return rc ;
+ }
SvREFCNT_dec (pDomTree -> pSV) ;
pDomTree -> pSV = NULL ;
@@ -1062,9 +1107,9 @@
}
-
if (!r -> bError)
{
+ rc = ok ;
cl1 = clock () ;
if (!(r -> xCurrDomTree = DomTree_clone (pDomTree, &pCurrDomTree)))
@@ -1082,8 +1127,10 @@
args[0] = r -> pReqSV ;
args[1] = newSViv (r -> xCurrDomTree) ;
- CallStoredCV (r, pProg, (CV *)pSV, 2, args, 0, &pSV) ;
+ rc = CallStoredCV (r, pProg, (CV *)pSV, 2, args, 0, &pSV) ;
SvREFCNT_dec (args[1]) ;
+ if (pSV)
+ SvREFCNT_dec (pSV) ;
}
cl2 = clock () ;
@@ -1095,6 +1142,8 @@
lprintf (r, "[%d]PERF: Run Time: %d ms \n", r -> nPid, ((cl2 - cl1) * 1000 / CLOCKS_PER_SEC)) ;
}
#endif
+ if (rc != ok && rc != rcEvalErr)
+ return rc ;
}
1.1.2.41 +21 -0 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.1.2.40
retrieving revision 1.1.2.41
diff -u -r1.1.2.40 -r1.1.2.41
--- epdom.c 2000/06/26 19:28:36 1.1.2.40
+++ epdom.c 2000/06/27 05:31:38 1.1.2.41
@@ -467,6 +467,27 @@
if (pPad && pPad -> nType == (tNodeType)ntypPad && xDomTree == pPad -> xDomTree)
{
+ tNodeData * pNode = NodePad_selfFirstChild (pDomTree,pPad) ;
+ int nOffset ;
+
+ while (pNode)
+ {
+ /* is it really save to leave out attr here????
+ int n = pNewNode -> numAttr ;
+ tAttrData * pAttr = Node_selfFirstAttr(pNewNode) ;
+
+ while (n--)
+ {
+ pDomTree -> pLookup[pAttr -> xNdx] = NULL ;
+ pAttr++ ;
+ }
+ */
+ pDomTree -> pLookup[pNode -> xNdx] = NULL ;
+ nOffset = sizeof (struct tNodeData) + sizeof (struct tAttrData) * pNode -> numAttr ;
+ if (pPad -> nFill <= pNode -> nPadOffset + nOffset)
+ break ;
+ pNode = (struct tNodeData *)(((tUInt8 *)pNode) + nOffset) ;
+ }
dom_free (pPad) ;
}
1.57.2.29 +1 -0 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.57.2.28
retrieving revision 1.57.2.29
diff -u -r1.57.2.28 -r1.57.2.29
--- test.pl 2000/06/19 04:15:25 1.57.2.28
+++ test.pl 2000/06/27 05:31:38 1.57.2.29
@@ -32,6 +32,7 @@
'varerr.htm???-1',
## 'varerr.htm???2',
'escape.htm',
+ 'escape.htm',
## 'spaces.htm',
'tagscan.htm',
'tagscan.htm??1',
No revision
No revision
1.1.2.3 +1 -1 embperl/test/cmp/Attic/errormismatch.htm
Index: errormismatch.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/errormismatch.htm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- errormismatch.htm 2000/06/14 12:27:39 1.1.2.2
+++ errormismatch.htm 2000/06/27 05:31:43 1.1.2.3
@@ -2,7 +2,7 @@
<H1>Internal Server Error</H1>
The server encountered an internal error or misconfiguration and was unable to complete your request.<P>
^Please contact the server administrator\,.*?and inform them of the time the error occurred\, and anything you might have done that may have caused the error
-^\[.*?\]ERR: 49: Line 13: Endtag '\/tr' doesn't match starttag 'table'<p>
+^\[.*?\]ERR: 49: Line (13|0): Endtag '\/tr' doesn't match starttag 'table'<p>
^.*?HTML\:\:Embperl.*?<P>
</BODY></HTML>
1.1.2.2 +1 -1 embperl/test/cmp/Attic/errormismatchcmd.htm
Index: errormismatchcmd.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/errormismatchcmd.htm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- errormismatchcmd.htm 2000/06/19 04:17:57 1.1.2.1
+++ errormismatchcmd.htm 2000/06/27 05:31:43 1.1.2.2
@@ -2,7 +2,7 @@
<H1>Internal Server Error</H1>
The server encountered an internal error or misconfiguration and was unable to complete your request.<P>
^Please contact the server administrator\,.*?and inform them of the time the error occurred\, and anything you might have done that may have caused the error
-^\[.*?\]ERR: 49: Line 16: Endtag 'endforeach' doesn't match starttag ''if', starttag should be 'foreach''<p>
+^\[.*?\]ERR: 49: Line (16|0): Endtag 'endforeach' doesn't match starttag ''if', starttag should be 'foreach''<p>
^.*?HTML\:\:Embperl.*?<P>
</BODY></HTML>
1.15.2.5 +3 -0 embperl/test/cmp/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/escape.htm,v
retrieving revision 1.15.2.4
retrieving revision 1.15.2.5
diff -u -r1.15.2.4 -r1.15.2.5
--- escape.htm 2000/06/14 11:49:03 1.15.2.4
+++ escape.htm 2000/06/27 05:31:43 1.15.2.5
@@ -43,6 +43,9 @@
Hash in A <a href="http://localhost/tests?A=1&B=2">
Array in A <a href="http://localhost/tests?X=9&Y=8&Z=7">
+Hash in H <a href="http://localhost/tests?A=1&B=2">
+Array in H <a href="http://localhost/tests?X=9&Y=8&Z=7">
+
1
Now lets look what we are getting from this:<BR>
No revision
No revision
1.11.2.4 +4 -0 embperl/test/html/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/escape.htm,v
retrieving revision 1.11.2.3
retrieving revision 1.11.2.4
diff -u -r1.11.2.3 -r1.11.2.4
--- escape.htm 2000/06/14 11:49:14 1.11.2.3
+++ escape.htm 2000/06/27 05:31:46 1.11.2.4
@@ -48,6 +48,10 @@
Hash in A <A HREF="http://localhost/tests?[+ [ %A ] +]">
Array in A <A HREF="http://localhost/tests?[+ \@A +]">
+[- %H = (A => 1, B => 2) ; @H = (X, 9, Y, 8, Z, 7) -]
+Hash in H <A HREF="http://localhost/tests?[+ \\%H +]">
+Array in H <A HREF="http://localhost/tests?[+ scalar { @H } +]">
+
[+ $escmode = 1 +]