Mailing List Archive

richter 00/05/11 00:28:14

Modified: . Tag: Embperl2 Embperl.pm Makefile.PL epcomp.c
epdom.c epdom.h epparse.c
Embperl Tag: Embperl2 Tokens.pm
Log:
Embperl 2 - Compile & Dom

Revision Changes Path
No revision


No revision


1.104.2.3 +4 -1 embperl/Embperl.pm

Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.104.2.2
retrieving revision 1.104.2.3
diff -u -r1.104.2.2 -r1.104.2.3
--- Embperl.pm 2000/05/03 14:03:49 1.104.2.2
+++ Embperl.pm 2000/05/11 07:27:52 1.104.2.3
@@ -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.2 2000/05/03 14:03:49 richter Exp $
+# $Id: Embperl.pm,v 1.104.2.3 2000/05/11 07:27:52 richter Exp $
#
###################################################################################

@@ -1207,6 +1207,9 @@
$req{'cleanup'} = -1 if (($req{'options'} & optDisableVarCleanup)) ;
$req{'options'} |= optSendHttpHeader ;
$req{'req_rec'} = $req_rec ;
+ my @errors ;
+ $req{'errors'} = \@errors ;
+ $req_rec -> pnotes ('EMBPERL_ERRORS', \@errors) ;

my $rc = Execute (\%req) ;




1.28.2.4 +1 -1 embperl/Makefile.PL

Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.28.2.3
retrieving revision 1.28.2.4
diff -u -r1.28.2.3 -r1.28.2.4
--- Makefile.PL 2000/05/03 20:57:30 1.28.2.3
+++ Makefile.PL 2000/05/11 07:27:53 1.28.2.4
@@ -839,7 +839,7 @@
WriteMakefile(
'NAME' => 'HTML::Embperl',
'VERSION_FROM' => 'Embperl.pm', # finds $VERSION
- 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT) epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT)' . $o,
+ 'OBJECT' => 'Embperl$(OBJ_EXT) epmain$(OBJ_EXT) epio$(OBJ_EXT) epchar$(OBJ_EXT) epcmd$(OBJ_EXT) eputil$(OBJ_EXT) epeval$(OBJ_EXT) epdbg$(OBJ_EXT) epparse$(OBJ_EXT) epdom$(OBJ_EXT) epcomp$(OBJ_EXT)' . $o,
'LIBS' => [''],
'DEFINE' => "$d \$(DEFS)",
'INC' => $i,



1.1.2.3 +39 -13 embperl/Attic/epcomp.c

Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- epcomp.c 2000/05/08 19:40:45 1.1.2.2
+++ epcomp.c 2000/05/11 07:27:54 1.1.2.3
@@ -24,7 +24,7 @@


tStringIndex nMaxEmbperlCmd ;
-struct tEmbperlCmd * * pEmbperlCmds ;
+struct tEmbperlCmd * pEmbperlCmds ;


/* ------------------------------------------------------------------------ */
@@ -36,16 +36,42 @@
/* ------------------------------------------------------------------------ */


-int embperl_CompileInit
+int embperl_CompileInit ()

{
- ArrayNew (&pEmbperlCmds, 256, sizeof (struct tNodeData *)) ;
- ArrayAdd (&pEmbperlCmds, 1) ;
- pEmbperlCmds[0] = NULL ;
+ ArrayNew (&pEmbperlCmds, 256, sizeof (struct tEmbperlCmd)) ;
+ ArraySet (&pEmbperlCmds, 0) ;
nMaxEmbperlCmd = 1 ;
}


+/* ------------------------------------------------------------------------ */
+/* */
+/* embperl_CompileInitItem */
+/* */
+/* */
+/* */
+/* ------------------------------------------------------------------------ */
+
+int embperl_CompileInitItem (/*i/o*/ register req * r,
+ /*in*/ HV * pHash,
+ /*in*/ int nNodeName)
+
+ {
+ ArraySet (&pEmbperlCmds, nNodeName) ;
+ if (nMaxEmbperlCmd < nNodeName)
+ nMaxEmbperlCmd = nNodeName ;
+
+ pEmbperlCmds[nNodeName].sPerlCode = GetHashValueStr (pHash, "perlcode", "") ;
+
+ if (r -> bDebug & dbgParse)
+ lprintf (r, "[%d]EPCOMP: InitItem %s (#%d) perlcode=%s\n", r -> nPid, Ndx2String(nNodeName), nNodeName, pEmbperlCmds[nNodeName].sPerlCode) ;
+
+ }
+
+
+
+

/* ------------------------------------------------------------------------ */
/* */
@@ -62,12 +88,12 @@
{
tNode xChildNode ;

- tNodeData * pNode = Node_self (xNode) ;
+ struct tNodeData * pNode = Node_self (xNode) ;
tStringIndex nNdx = Node_selfNodeNameNdx (pNode) ;

- if (nNdx < nMaxEmbperlCmd)
+ if (nNdx <= nMaxEmbperlCmd)
{
- struct tEmbperlCmd * pCmd = pEmbperlCmds[nNdx] ;
+ struct tEmbperlCmd * pCmd = &pEmbperlCmds[nNdx] ;
if (pCmd)
{
const char * sPerlCode ;
@@ -81,12 +107,12 @@
{
int n = p - sPerlCode ;
printf ("%*.*s", n, n, sPerlCode) ;
- q = strchr (p, '%') ;
+ q = strchr (p+1, '%') ;
if (q)
{
if (p[1] == '#')
{
- int nChildNo = atoi (p[2]) ;
+ int nChildNo = atoi (&p[2]) ;
struct tNodeData * pChildNode = Node_selfNthChild (pNode, nChildNo) ;

if (pChildNode)
@@ -96,9 +122,9 @@
}
else
{
- const char * sVal = Element_selfGetAttribut (pNode, p, p - q - 1) ;
+ const char * sVal = Element_selfGetAttribut (pNode, p + 1, q - p - 1) ;

- puts (sVal) ;
+ puts (sVal?sVal:"") ;
}

sPerlCode = q + 1 ;
@@ -118,7 +144,7 @@



- tNode xChildNode = Node_firstChild (xNode) ;
+ xChildNode = Node_firstChild (xNode) ;

while (xChildNode)
{



1.1.2.6 +133 -12 embperl/Attic/epdom.c

Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- epdom.c 2000/05/08 19:40:46 1.1.2.5
+++ epdom.c 2000/05/11 07:27:54 1.1.2.6
@@ -52,6 +52,7 @@
if ((pNew = dom_malloc (nAdd * nElementSize + sizeof (struct tArrayCtrl))) == NULL)
return 0 ;

+ memset (pNew, 0, nAdd * nElementSize + sizeof (struct tArrayCtrl)) ;
*(void * *)pArray = (struct tArray *)(pNew + 1) ;
pNew -> nMax = nAdd ;
pNew -> nAdd = nAdd ;
@@ -97,7 +98,45 @@
return nNdx ;
}

+/* ------------------------------------------------------------------------ */
+/* */
+/* ArraySet */
+/* */
+/* Make space that at least numElements in the Array */
+/* */
+/* ------------------------------------------------------------------------ */
+
+
+int ArraySet (/*in*/ const tArray * pArray,
+ /*in*/ int numElements)
+
+ {
+ struct tArrayCtrl * pCtrl = ((struct tArrayCtrl *)(*(void * *)pArray)) - 1 ;
+ int nNdx ;
+ char * p ;
+
+ if (numElements > pCtrl -> nMax)
+ {
+ struct tArrayCtrl * pNew ;
+ int nNewMax = pCtrl -> nFill + pCtrl -> nAdd ;

+ if (nNewMax < numElements)
+ nNewMax = numElements + pCtrl -> nAdd ;
+
+ if ((pNew = realloc (pCtrl, nNewMax * pCtrl -> nElementSize + sizeof (struct tArrayCtrl))) == NULL)
+ return 0 ;
+
+ p = (char *)(pNew + 1) ;
+ *(void * *)pArray = (struct tArray *)p ;
+ memset (p + pNew -> nMax * pNew -> nElementSize, 0, (nNewMax - pNew -> nMax) * pNew -> nElementSize) ;
+ pNew -> nMax = nNewMax ;
+ pCtrl = pNew ;
+ }
+
+ return numElements ;
+ }
+
+
/* ------------------------------------------------------------------------ */
/* */
/* String2Ndx */
@@ -107,8 +146,8 @@
/* ------------------------------------------------------------------------ */


-int String2Ndx (/*in*/ const char * sText,
- /*in*/ int nLen)
+tStringIndex String2Ndx (/*in*/ const char * sText,
+ /*in*/ int nLen)

{
SV * * ppSV ;
@@ -147,7 +186,7 @@
/* */
/* ------------------------------------------------------------------------ */

-const char * Ndx2String (/*in*/ int nNdx)
+const char * Ndx2String (/*in*/ tStringIndex nNdx)

{
return pStringTableArray[nNdx] ;
@@ -287,7 +326,7 @@
struct tNodeData * pParent = pNodeLookup [xParent] ;

if (r -> bDebug & dbgParse)
- lprintf (r, "[%d]PARSE: AddNode: +%02d parent=%d %*s type=%d text=%*.*s\n", r -> nPid, nLevel, xParent, nLevel * 2, "", nType, nTextLen, nTextLen, sText) ;
+ lprintf (r, "[%d]PARSE: AddNode: +%02d parent=%d %*s type=%d text=%*.*s (#%d)\n", r -> nPid, nLevel, xParent, nLevel * 2, "", nType, nTextLen, nTextLen, sText, sText?String2Ndx (sText, nTextLen):-1) ;

if (nType == ntypAttr)
{
@@ -417,6 +456,9 @@

{
struct tNodePad * pPad = pPadLookup[pNodeLookup [xNode] -> xChilds] ;
+ if (pPad == NULL)
+ return 0 ;
+
return ((struct tNodeData *)(pPad + 1)) -> xNdx ;
}

@@ -430,21 +472,100 @@
/* ------------------------------------------------------------------------ */


-tNodeData * Node_selfNthChild (/*in*/ tNodeData * pNode,
- /*in*/ int nChildNo)
+struct tNodeData * Node_selfNthChild (/*in*/ struct tNodeData * pNode,
+ /*in*/ int nChildNo)

{
- struct tNodePad * pPad = pPadLookup[pNodeLookup [xNode] -> xChilds] ;
- int n = 0;
- while (nChildNo > n + pPad -> numChilds && pPad -> xNext)
+ struct tNodePad * pPad = pPadLookup[pNode -> xChilds] ;
+ struct tNodeData * pChildNode ;
+
+ if (pPad == NULL)
+ return 0 ;
+
+ while (nChildNo >= pPad -> numChilds && pPad -> xNext)
{
- n += pPad -> numChilds ;
+ nChildNo -= pPad -> numChilds ;
pPad = pPadLookup[pPad -> xNext] ;
}

- if (nChildNo > n)
+ if (nChildNo < 0)
return NULL ;
+
+
+ pChildNode = ((struct tNodeData *)(pPad + 1)) ;
+ while (nChildNo > 0)
+ {
+ nChildNo-- ;
+ pChildNode = (struct tNodeData *)(((tUInt8 *)pChildNode) + sizeof (struct tNodeData) + sizeof (struct tAttrData) * pChildNode -> numAttr) ;
+ }
+
+
+ return pChildNode ;
+ }

- return ((struct tNodeData *)(pPad + 1)) + (nChildNo - n) ;
+
+/* ------------------------------------------------------------------------ */
+/* */
+/* Node_nextSibling (xNode) ; */
+/* */
+/* Get next sibling node */
+/* */
+/* ------------------------------------------------------------------------ */
+
+
+tNode Node_nextSibling (/*in*/ tNode xNode)
+
+ {
+ struct tNodeData * pNode = pNodeLookup[xNode] ;
+ struct tNodePad * pPad = (struct tNodePad * )(((tUInt8 *)pNode) - pNode -> nPadNdx) ;
+
+ int nOffset = sizeof (struct tNodeData) + sizeof (struct tAttrData) * pNode -> numAttr ;
+
+ if (pPad -> nFill <= pNode -> nPadNdx + nOffset)
+ { /* next pad */
+ if (!pPad -> xNext)
+ return 0 ;
+
+ pPad = pPadLookup[pPad -> xNext] ;
+ return ((struct tNodeData *)(pPad + 1)) -> xNdx ;
+ }
+
+ pNode = (struct tNodeData *)(((tUInt8 *)pNode) + nOffset) ;
+ return pNode -> xNdx ;
}
+
+
+/* ------------------------------------------------------------------------ */
+/* */
+/* Element_selfGetAttribut */
+/* */
+/* Get attribute value of Element by name */
+/* */
+/* ------------------------------------------------------------------------ */
+
+
+
+const char * Element_selfGetAttribut (/*in*/ struct tNodeData * pNode,
+ /*in*/ const char * sAttrName,
+ /*in*/ int nAttrNameLen)
+
+ {
+ int nAttrName = String2Ndx (sAttrName, nAttrNameLen) ;
+ struct tAttrData * pAttr = (struct tAttrData * )(pNode + 1) ;
+ int n = pNode -> numAttr ;
+
+ while (n > 0 && nAttrName != pAttr -> nName)
+ {
+ n-- ;
+ pAttr++ ;
+ }
+
+ if (n)
+ return Ndx2String (pAttr -> nValue) ;
+
+ return NULL ;
+ }
+
+
+




1.1.2.3 +23 -2 embperl/Attic/epdom.h

Index: epdom.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.h,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- epdom.h 2000/05/08 19:40:47 1.1.2.2
+++ epdom.h 2000/05/11 07:27:54 1.1.2.3
@@ -31,6 +31,7 @@
typedef signed long tSInt32 ;

typedef tUInt16 tIndex ;
+typedef tUInt16 tStringIndex ;

typedef tUInt8 tNodeType ;
typedef tIndex tNode ;
@@ -84,8 +85,21 @@
} ;


+extern struct tNodeData * * pNodeLookup ;
+extern struct tNodePad * * pPadLookup ;
+extern const char * * pStringTableArray ; /* Array with pointers to strings */


+
+tStringIndex String2Ndx (/*in*/ const char * sText,
+ /*in*/ int nLen) ;
+
+const char * Ndx2String (/*in*/ tStringIndex nNdx) ;
+
+
+
+
+
tNode Node_appendChild (/*i/o*/ register req * r,
/*in*/ tNodeType nType,
/*in*/ const char * sText,
@@ -97,7 +111,13 @@
tNode Node_parentNode (/*in*/ tNode xNode) ;


+tNode Node_firstChild (/*in*/ tNode xNode) ;
+
+struct tNodeData * Node_selfNthChild (/*in*/ struct tNodeData * pNode,
+ /*in*/ int nChildNo) ;
+

+tNode Node_nextSibling (/*in*/ tNode xNode) ;


#define Node_self(xNode) (pNodeLookup[xNode])
@@ -106,8 +126,9 @@
#define Node_selfNodeName(pNode) (pStringTableArray[pNode -> nText])


-Node_nextSibling (xChildNode) ;
+const char * Element_selfGetAttribut (/*in*/ struct tNodeData * pNode,
+ /*in*/ const char * sAttrName,
+ /*in*/ int nAttrNameLen) ;


-Element_selfGetAttribut (pNode, p, p - q - 1) ;




1.1.2.9 +83 -3 embperl/Attic/epparse.c

Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.1.2.8
retrieving revision 1.1.2.9
diff -u -r1.1.2.8 -r1.1.2.9
--- epparse.c 2000/05/08 19:40:47 1.1.2.8
+++ epparse.c 2000/05/11 07:27:55 1.1.2.9
@@ -25,6 +25,7 @@
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 */
unsigned char * pContains ; /* chars that could becontains in the string */
@@ -71,6 +72,72 @@
{
return strcmp (*((const char * *)p2), *((const char * *)p1)) ;
}
+
+
+
+/* ------------------------------------------------------------------------ */
+/* */
+/* CheckProcInfo */
+/* */
+/* Check for processor informations */
+/* */
+/* ------------------------------------------------------------------------ */
+
+int CheckProcInfo (/*i/o*/ register req * r,
+ /*in*/ HV * pHash,
+ /*in*/ struct tToken * pToken)
+
+
+ {
+ int rc ;
+ HE * pEntry ;
+ char * pKey ;
+ SV * * ppSV ;
+ SV * pSVValue ;
+ IV l ;
+ HV * pHVProcInfo ;
+
+ ppSV = hv_fetch(pHash, "procinfo", sizeof ("procinfo") - 1, 0) ;
+ if (ppSV != NULL)
+ {
+ if (*ppSV == NULL || !SvROK (*ppSV) || SvTYPE (SvRV (*ppSV)) != SVt_PVHV)
+ {
+ strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1)) ;
+ sprintf (r -> errdat2, "%s => procinfo", pToken -> sText) ;
+ return rcNotHashRef ;
+ }
+
+ pHVProcInfo = (HV *)SvRV (*ppSV) ;
+
+ hv_iterinit (pHVProcInfo ) ;
+ while (pEntry = hv_iternext (pHVProcInfo))
+ {
+ HV * pProcInfoHash ;
+
+ pKey = hv_iterkey (pEntry, &l) ;
+ pSVValue = hv_iterval (pHVProcInfo , pEntry) ;
+
+ if (pSVValue == NULL || !SvROK (pSVValue) || SvTYPE (SvRV (pSVValue)) != SVt_PVHV)
+ {
+ strncpy (r -> errdat1, "BuildTokenHash", sizeof (r -> errdat1)) ;
+ sprintf (r -> errdat2, "%s => procinfo", pToken -> sText) ;
+ return rcNotHashRef ;
+ }
+
+ if (strcmp (pKey, "embperl") == 0)
+ embperl_CompileInitItem (r, SvRV (pSVValue), pToken -> nNodeName) ;
+ }
+ }
+
+
+ return ok ;
+ }
+
+
+
+
+
+

/* ------------------------------------------------------------------------ */
/* */
@@ -231,9 +298,20 @@
c++ ;
}

+
if (r -> bDebug & dbgBuildToken)
lprintf (r, "[%d]TOKEN: %s ... %s\n", r -> nPid, p -> sText, p -> pContains?sContains:p -> sEndText) ;

+ if (p -> sNodeName)
+ p -> nNodeName = String2Ndx (p -> sNodeName, strlen (p -> sNodeName)) ;
+ else
+ p -> nNodeName = String2Ndx (p -> sText, strlen (p -> sText)) ;
+
+
+ if ((rc = CheckProcInfo (r, pHash, p)) != ok)
+ return rc ;
+
+
if ((rc = BuildSubTokenTable (r, pHash, pKey, "follow", p -> sEndText, &pNewTokenTable)))
return rc ;
p -> pFollowedBy = pNewTokenTable ;
@@ -498,7 +576,8 @@
tNode xDocNode ;

DomInit () ;
-
+ embperl_CompileInit () ;
+
if ((pTokenHash = perl_get_hv ((char *)sTokenHash, TRUE)) == NULL)
{
return rcHashError ;
@@ -515,9 +594,10 @@
if (!(xDocNode = Node_appendChild (r, ntypTag, "doc", 3, 0, 0)))
return 1 ;

- return ParseTokens (r, &pStart, pEnd, &pTable, "", NULL, ntypCDATA, "root", xDocNode, 0) ;
-
+ if ((rc = ParseTokens (r, &pStart, pEnd, &pTable, "", NULL, ntypCDATA, "root", xDocNode, 0)) != ok)
+ return rc ;

+ return embperl_CompileDocument (xDocNode) ;
}





No revision


No revision


1.1.2.6 +50 -11 embperl/Embperl/Attic/Tokens.pm

Index: Tokens.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Tokens.pm,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- Tokens.pm 2000/05/04 05:42:04 1.1.2.5
+++ Tokens.pm 2000/05/11 07:28:12 1.1.2.6
@@ -55,7 +55,10 @@
'type' => { 'text' => 'type', 'nodename' => 'type', follow => \%AssignAttr },
'name' => { 'text' => 'name', 'nodename' => 'name', follow => \%AssignAttr },
'value' => { 'text' => 'value', 'nodename' => 'value', follow => \%AssignAttr },
- }
+ },
+ 'procinfo' => {
+ embperl => { perlcode => 'Input (%type%, %name%, %value%) ;' }
+ },
},
'tr' => {
'text' => 'tr',
@@ -117,34 +120,64 @@

%MetaCmds = (
'if' => {
- 'text' => 'if'
+ 'text' => 'if',
+ 'procinfo' => {
+ embperl => { perlcode => 'if (%#0%) { ' }
+ },
},
'else' => {
- 'text' => 'else'
+ 'text' => 'else',
+ 'procinfo' => {
+ embperl => { perlcode => '} else {' }
+ },
},
'endif' => {
- 'text' => 'endif'
+ 'text' => 'endif',
+ 'procinfo' => {
+ embperl => { perlcode => '} ;' }
+ },
},
'elsif' => {
- 'text' => 'elseif'
+ 'text' => 'elseif',
+ 'procinfo' => {
+ embperl => { perlcode => '} elsif (%#0%) { ' }
+ },
},
'while' => {
- 'text' => 'while'
+ 'text' => 'while',
+ 'procinfo' => {
+ embperl => { perlcode => 'while (%#0%) { ' }
+ },
},
'endwhile' => {
- 'text' => 'endwhile'
+ 'text' => 'endwhile',
+ 'procinfo' => {
+ embperl => { perlcode => '} ;' }
+ },
},
'foreach' => {
- 'text' => 'foreach'
+ 'text' => 'foreach',
+ 'procinfo' => {
+ embperl => { perlcode => 'foreach (%#0%) { ' }
+ },
},
'endforeach' => {
- 'text' => 'endforeach'
+ 'text' => 'endforeach',
+ 'procinfo' => {
+ embperl => { perlcode => '} ;' }
+ },
},
'do' => {
- 'text' => 'do'
+ 'text' => 'do',
+ 'procinfo' => {
+ embperl => { perlcode => 'do { ' }
+ },
},
'until' => {
- 'text' => 'until'
+ 'text' => 'until',
+ 'procinfo' => {
+ embperl => { perlcode => '} until (%#0%) ; ' }
+ },
},

) ;
@@ -162,10 +195,16 @@
'Embperl output code' => {
'text' => '[+',
'end' => '+]',
+ 'procinfo' => {
+ embperl => { perlcode => 'Output (%#0%) ; ' }
+ },
},
'Embperl code' => {
'text' => '[-',
'end' => '-]',
+ 'procinfo' => {
+ embperl => { perlcode => '%#0% ; ' }
+ },
},
'Embperl startup code' => {
'text' => '[!',