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/03/23 10:28:16 UTC
cvs commit: embperl/test/html syntax.htm
richter 01/03/23 01:28:16
Modified: . Tag: Embperl2c Changes.pod Embperl.xs Syntax.xs
ep2.h epcomp.c epdat.h epdom.c epparse.c test.pl
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c EmbperlBlocks.pm Perl.pm
SSI.pm
test/cmp Tag: Embperl2c ssibasic.htm
test/html Tag: Embperl2c syntax.htm
Log:
Embperl 2 - print OUT, Perl syntax, SSI syntax
Revision Changes Path
No revision
No revision
1.129.4.9 +4 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.8
retrieving revision 1.129.4.9
diff -u -r1.129.4.8 -r1.129.4.9
--- Changes.pod 2001/03/07 20:43:22 1.129.4.8
+++ Changes.pod 2001/03/23 09:28:10 1.129.4.9
@@ -12,7 +12,10 @@
- Which syntax (also multiple at the same time)
a given page uses can be defined via EMBPERL_SYNTAX configuration
directive.
-
+ - Added Syntax definitions for SSI, Perl and plain Text
+ - New [$ syntax $] metacommand can switch the syntax of the file
+ on the fly. It's also usefull to load addtional taglibs.
+ - print OUT works again
=head1 2.0b1 (BETA) 22. Dec 2000
1.29.4.11 +22 -1 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.10
retrieving revision 1.29.4.11
diff -u -r1.29.4.10 -r1.29.4.11
--- Embperl.xs 2001/03/22 09:04:40 1.29.4.10
+++ Embperl.xs 2001/03/23 09:28:10 1.29.4.11
@@ -238,6 +238,14 @@
STRLEN l ;
tReq * r = pCurrReq ;
CODE:
+#ifdef EP2
+ if (!r->bEP1Compat)
+ {
+ char * p = SvPV (sText, l) ;
+ Node_appendChild (DomTree_self (r -> xCurrDomTree), ntypCDATA, 0, p, l, r -> xCurrNode, 0, 0) ;
+ }
+ else
+#endif
if (r -> pCurrEscape == NULL)
{
char * p = SvPV (sText, l) ;
@@ -693,14 +701,27 @@
RETVAL = "" ;
OUTPUT:
RETVAL
+
-
void
embperl_Syntax(r, pSyntaxObj)
tReq * r
tTokenTable * pSyntaxObj ;
CODE:
r -> pTokenTable = pSyntaxObj ;
+
+SV *
+embperl_Code(r,...)
+ tReq * r
+CODE:
+ RETVAL = r -> pCodeSV ;
+ if (items > 1)
+ {
+ r -> pCodeSV = ST(1) ;
+ SvREFCNT_inc (ST(1)) ;
+ }
+OUTPUT:
+ RETVAL
1.1.2.6 +2 -2 embperl/Attic/Syntax.xs
Index: Syntax.xs
===================================================================
RCS file: /home/cvs/embperl/Attic/Syntax.xs,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- Syntax.xs 2001/03/22 09:04:41 1.1.2.5
+++ Syntax.xs 2001/03/23 09:28:10 1.1.2.6
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.xs,v 1.1.2.5 2001/03/22 09:04:41 richter Exp $
+# $Id: Syntax.xs,v 1.1.2.6 2001/03/23 09:28:10 richter Exp $
#
###################################################################################
@@ -52,6 +52,6 @@
if (ppSV == NULL || *ppSV == NULL || !SvROK (*ppSV))
croak ("Internal Error: pSyntaxObj has no -root") ;
else
- if ((rc = BuildTokenTable (pCurrReq, sName, (HV *)(SvRV(*ppSV)), "", NULL, pTab)) != ok)
+ if ((rc = BuildTokenTable (pCurrReq, 0, sName, (HV *)(SvRV(*ppSV)), "", NULL, pTab)) != ok)
LogError (pCurrReq, rc) ;
1.1.2.11 +1 -0 embperl/Attic/ep2.h
Index: ep2.h
===================================================================
RCS file: /home/cvs/embperl/Attic/ep2.h,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -u -r1.1.2.10 -r1.1.2.11
--- ep2.h 2001/03/22 09:04:42 1.1.2.10
+++ ep2.h 2001/03/23 09:28:11 1.1.2.11
@@ -49,6 +49,7 @@
extern struct tTokenTable DefaultTokenTable ;
int BuildTokenTable (/*i/o*/ register req * r,
+ /*in*/ int nLevel,
/*in*/ const char * sName,
/*in*/ HV * pTokenHash,
/*in*/ const char * pDefEnd,
1.4.2.39 +96 -39 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.38
retrieving revision 1.4.2.39
diff -u -r1.4.2.38 -r1.4.2.39
--- epcomp.c 2001/03/22 09:04:42 1.4.2.38
+++ epcomp.c 2001/03/23 09:28:11 1.4.2.39
@@ -850,33 +850,80 @@
{
int rc ;
char * pCode = NULL ;
+ char * pCTCode = NULL ;
char * sSourcefile ;
int nSourcefile ;
int i ;
- SV * args[2] ;
+ SV * args[4] ;
+ int nCodeLen ;
+ int found = 0 ;
+ r -> pCodeSV = NULL ;
Ndx2StringLen (pDomTree -> xFilename, sSourcefile, nSourcefile) ;
if (pCmd -> nNodeType != pNode -> nType)
return ok ;
+ for (i = 0; i < pCmd -> numPerlCode; i++)
+ if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sPerlCode[i], &pCode))
+ {
+ found = 1 ;
+ break ;
+ }
+
+ if (found && pCode)
+ {
+ nCodeLen = ArrayGetSize (pCode) ;
+
+ if (nCodeLen)
+ {
+ char buf [32] ;
+
+ if (pNode -> nLinenumber)
+ {
+ int l2 = sprintf (buf, "#line %d \"", pNode -> nLinenumber) ;
+
+ StringAdd (r -> pProg, buf, l2) ;
+ StringAdd (r -> pProg, sSourcefile, nSourcefile) ;
+ StringAdd (r -> pProg, "\"\n", 2) ;
+ }
+
+ if (pCmd -> bPerlCodeRemove)
+ *nStartCodeOffset = StringAdd (r -> pProg, " ", 1) ;
+ }
+ else
+ {
+ StringFree (&pCode) ;
+ pCode = NULL ;
+ }
+ }
+ else
+ {
+ StringFree (&pCode) ;
+ pCode = NULL ;
+ }
+
for (i = 0; i < pCmd -> numCompileTimePerlCode; i++)
{
- if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sCompileTimePerlCode[i], &pCode))
+ if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sCompileTimePerlCode[i], &pCTCode))
{
SV * pSV ;
int rc ;
- if (pCode)
+ if (pCTCode)
{
- int l = ArrayGetSize (pCode) ;
+ int l = ArrayGetSize (pCTCode) ;
if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CompileTimeCode: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCode) ;
+ lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d CompileTimeCode: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCTCode) ;
- pSV = newSVpvf("package %s ;\nmy ($_ep_req) = @_;\n#line %d \"%s\"\n%*.*s",
- pCurrReq -> Buf.sEvalPackage, pNode -> nLinenumber, sSourcefile, l,l, pCode) ;
+ pSV = newSVpvf("package %s ;\n#line %d \"%s\"\n%*.*s",
+ pCurrReq -> Buf.sEvalPackage, pNode -> nLinenumber, sSourcefile, l,l, pCTCode) ;
args[0] = r -> pReqSV ;
+ if (pCode)
+ {
+ r -> pCodeSV = newSVpv (pCode, nCodeLen) ;
+ }
if ((rc = EvalDirect (r, pSV, 1, args)) != ok)
LogError (r, rc) ;
SvREFCNT_dec(pSV);
@@ -884,41 +931,32 @@
break ;
}
}
- for (i = 0; i < pCmd -> numPerlCode; i++)
- {
- if (embperl_CompileToPerlCode (pDomTree, pNode, pCmd -> sPerlCode[i], &pCode))
- {
- if (pCode)
- {
- int l = ArrayGetSize (pCode) ;
-
- if (l)
- {
- char buf [32] ;
-
- if (pNode -> nLinenumber)
- {
- int l2 = sprintf (buf, "#line %d \"", pNode -> nLinenumber) ;
-
- StringAdd (r -> pProg, buf, l2) ;
- StringAdd (r -> pProg, sSourcefile, nSourcefile) ;
- StringAdd (r -> pProg, "\"\n", 2) ;
- }
- if (pCmd -> bPerlCodeRemove)
- *nStartCodeOffset = StringAdd (r -> pProg, " ", 1) ;
- StringAdd (r -> pProg, pCode, l) ;
- StringAdd (r -> pProg, "\n", 1) ;
- if (pCurrReq -> bDebug & dbgParse)
- lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d Code: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, l, l, pCode) ;
- }
- }
- break ;
- }
+ if (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 Code: %s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, p) ;
}
-
+ else if (pCode)
+ {
+ StringAdd (r -> pProg, pCode, nCodeLen ) ;
+ StringAdd (r -> pProg, "\n", 1) ;
+ if (pCurrReq -> bDebug & dbgParse)
+ lprintf (pCurrReq, "[%d]EPCOMP: #%d L%d Code: %*.*s\n", pCurrReq -> nPid, pNode -> xNdx, pNode -> nLinenumber, nCodeLen, nCodeLen, pCode) ;
+ }
+
StringFree (&pCode) ;
+ StringFree (&pCTCode) ;
+ if (r -> pCodeSV)
+ {
+ SvREFCNT_dec(r -> pCodeSV);
+ r -> pCodeSV = NULL ;
+ }
return ok ;
}
@@ -962,6 +1000,25 @@
pNode -> bFlags = 0 ;
else if (pCmd -> bRemoveNode & 8)
pNode -> bFlags |= nflgIgnore ;
+ else if (pCmd -> bRemoveNode & 16)
+ {
+ tNodeData * pChild ;
+ while (pChild = Node_selfFirstChild (pDomTree, pNode))
+ {
+ Node_selfRemoveChild (pDomTree, pNode -> xNdx, pChild) ;
+ }
+ }
+ else if (pCmd -> bRemoveNode & 32)
+ {
+ tNodeData * pChild = Node_selfFirstChild (pDomTree, pNode) ;
+ while (pChild)
+ {
+ pChild -> bFlags |= nflgIgnore ;
+ pChild = Node_selfNextSibling (pDomTree, pChild) ;
+
+ }
+ }
+
if (nCheckpointCodeOffset && (pNode -> bFlags == 0 || (pNode -> bFlags & nflgIgnore)))
{
@@ -1445,7 +1502,7 @@
if (l && pCurrReq -> bDebug & dbgParse)
lprintf (r, "[%d]EPCOMP: AfterCompileTimeCode: %*.*s\n", r -> nPid, l, l, r -> pProgDef) ;
- pSV = newSVpvf("package %s ; \nmy ($_ep_req, $ep_DomTree) = @_;\n%*.*s", r -> Buf.sEvalPackage, l,l, r -> pProgDef) ;
+ pSV = newSVpvf("package %s ; \nmy ($_ep_req, $_ep_DomTree) = @_;\n%*.*s", r -> Buf.sEvalPackage, l,l, r -> pProgDef) ;
args[0] = r -> pReqSV ;
args[1] = pDomTree -> pDomTreeSV ;
if ((rc = EvalDirect (r, pSV, 2, args)) != ok)
1.20.4.13 +1 -0 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.20.4.12
retrieving revision 1.20.4.13
diff -u -r1.20.4.12 -r1.20.4.13
--- epdat.h 2001/03/22 09:04:43 1.20.4.12
+++ epdat.h 2001/03/23 09:28:11 1.20.4.13
@@ -540,6 +540,7 @@
char * pProgRun ; /* pointer into currently compiled run code */
char * pProgDef ; /* pointer into currently compiled define code */
+ SV * pCodeSV ; /* contains currently compiled line */
#endif
} ;
1.4.2.24 +2 -0 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.23
retrieving revision 1.4.2.24
diff -u -r1.4.2.23 -r1.4.2.24
--- epdom.c 2000/12/22 05:48:56 1.4.2.23
+++ epdom.c 2001/03/23 09:28:11 1.4.2.24
@@ -529,8 +529,10 @@
if (bInc)
SvREFCNT_inc (*ppSV) ;
nNdx = SvIVX (*ppSV) ;
+ /*
if (nNdx < 6 || nNdx == 92)
lprintf (pCurrReq, "old string %s (#%d) refcnt=%d\n", Ndx2String (nNdx), nNdx, SvREFCNT(*ppSV)) ;
+ */
return nNdx ;
}
}
1.4.2.14 +12 -8 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.13
retrieving revision 1.4.2.14
diff -u -r1.4.2.13 -r1.4.2.14
--- epparse.c 2001/03/22 09:04:43 1.4.2.13
+++ epparse.c 2001/03/23 09:28:11 1.4.2.14
@@ -132,7 +132,8 @@
/* ------------------------------------------------------------------------ */
static int BuildSubTokenTable (/*i/o*/ register req * r,
- /*in*/ HV * pHash,
+ /*in*/ int nLevel,
+ /*in*/ HV * pHash,
/*in*/ const char * pKey,
/*in*/ const char * pAttr,
/*in*/ const char * pDefEnd,
@@ -144,6 +145,8 @@
SV * * ppSV ;
int rc ;
+ nLevel++ ;
+
ppSV = hv_fetch(pHash, (char *)pAttr, strlen (pAttr), 0) ;
if (ppSV != NULL)
{
@@ -164,11 +167,11 @@
return rcOutOfMemory ;
if (r -> bDebug & dbgBuildToken)
- lprintf (r, "[%d]TOKEN: -> %s\n", r -> nPid, pAttr) ;
- if ((rc = BuildTokenTable (r, NULL, pSubHash, pDefEnd, ppCompilerInfo, pNewTokenTable)))
+ lprintf (r, "[%d]TOKEN: %*c-> %s\n", r -> nPid, nLevel*2, ' ', pAttr) ;
+ if ((rc = BuildTokenTable (r, nLevel, NULL, pSubHash, pDefEnd, ppCompilerInfo, pNewTokenTable)))
return rc ;
if (r -> bDebug & dbgBuildToken)
- lprintf (r, "[%d]TOKEN: <- %s\n", r -> nPid, pAttr) ;
+ lprintf (r, "[%d]TOKEN: %*c<- %s\n", r -> nPid, nLevel*2, ' ', pAttr) ;
if (pNewTokenTable -> numTokens == 0)
{
@@ -181,7 +184,7 @@
}
else
if (r -> bDebug & dbgBuildToken)
- lprintf (r, "[%d]TOKEN: -> %s already build; numTokens=%d\n", r -> nPid, pAttr, pNewTokenTable->numTokens) ;
+ lprintf (r, "[%d]TOKEN: %*c-> %s already build; numTokens=%d\n", r -> nPid, nLevel*2, ' ', pAttr, pNewTokenTable->numTokens) ;
*pTokenTable = pNewTokenTable ;
@@ -202,6 +205,7 @@
/* ------------------------------------------------------------------------ */
int BuildTokenTable (/*i/o*/ register req * r,
+ /*in*/ int nLevel,
/*in*/ const char * sName,
/*in*/ HV * pTokenHash,
/*in*/ const char * pDefEnd,
@@ -318,7 +322,7 @@
if (r -> bDebug & dbgBuildToken)
- lprintf (r, "[%d]TOKEN: %s ... %s unesc=%d nodetype=%d, cdatatype=%d, nodename=%s\n", r -> nPid, p -> sText, p -> pContains?sContains:p -> sEndText, p -> bUnescape, p -> nNodeType, p -> nCDataType, p -> sNodeName?p -> sNodeName:"<null>") ;
+ lprintf (r, "[%d]TOKEN: %*c%s ... %s unesc=%d nodetype=%d, cdatatype=%d, nodename=%s\n", r -> nPid, nLevel*2, ' ', p -> sText, p -> pContains?sContains:p -> sEndText, p -> bUnescape, p -> nNodeType, p -> nCDataType, p -> sNodeName?p -> sNodeName:"<null>") ;
if (p -> sNodeName)
p -> nNodeName = String2Ndx (p -> sNodeName, strlen (p -> sNodeName)) ;
@@ -330,11 +334,11 @@
return rc ;
- if ((rc = BuildSubTokenTable (r, pHash, pKey, "follow", p -> sEndText, ppCompilerInfo, &pNewTokenTable)))
+ if ((rc = BuildSubTokenTable (r, nLevel, pHash, pKey, "follow", p -> sEndText, ppCompilerInfo, &pNewTokenTable)))
return rc ;
p -> pFollowedBy = pNewTokenTable ;
- if ((rc = BuildSubTokenTable (r, pHash, pKey, "inside", "", ppCompilerInfo, &pNewTokenTable)))
+ if ((rc = BuildSubTokenTable (r, nLevel, pHash, pKey, "inside", "", ppCompilerInfo, &pNewTokenTable)))
return rc ;
p -> pInside = pNewTokenTable ;
1.70.4.34 +7 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.33
retrieving revision 1.70.4.34
diff -u -r1.70.4.33 -r1.70.4.34
--- test.pl 2001/03/20 08:01:53 1.70.4.33
+++ test.pl 2001/03/23 09:28:11 1.70.4.34
@@ -4,7 +4,7 @@
use HTML::Embperl::Syntax ;
-#my $syn = HTML::Embperl::Syntax::GetSyntax ('Text') ;
+#my $syn = HTML::Embperl::Syntax::GetSyntax ('SSI') ;
@testdata = (
'ascii' => { },
@@ -474,6 +474,10 @@
'incperl.htm' => {
'version' => 2,
},
+ 'syntax.htm' => {
+ 'version' => 2,
+ 'repeat' => 2,
+ },
) ;
for ($i = 0 ; $i < @testdata; $i += 2)
@@ -1206,7 +1210,8 @@
delete $ENV{EMBPERL_OPTIONS} if (defined ($ENV{EMBPERL_OPTIONS})) ;
$ENV{EMBPERL_OPTIONS} = $test -> {option} if (defined ($test -> {option})) ;
- $ENV{EMBPERL_SYNTAX} = $test -> {syntax} if (defined ($test -> {syntax})) ;
+ delete $ENV{EMBPERL_SYNTAX} ;
+ $ENV{EMBPERL_SYNTAX} = $test -> {syntax} if (defined ($test -> {syntax})) ;
$ENV{EMBPERL_COMPARTMENT} = $test -> {compartment} if (defined ($test -> {compartment})) ;
@testargs = ( '-o', $outfile ,
'-l', $logfile,
No revision
No revision
1.1.4.26 +40 -3 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.25
retrieving revision 1.1.4.26
diff -u -r1.1.4.25 -r1.1.4.26
--- Syntax.pm 2001/03/22 09:04:49 1.1.4.25
+++ Syntax.pm 2001/03/23 09:28:13 1.1.4.26
@@ -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.25 2001/03/22 09:04:49 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.26 2001/03/23 09:28:13 richter Exp $
#
###################################################################################
@@ -179,11 +179,40 @@
sub GetSyntax
{
- my ($name) = @_ ;
+ my ($name, $oldname) = @_ ;
- my @names = map { /::/?$_:'HTML::Embperl::Syntax::'. $_ } split (/\s/, $name) ;
+ my %names ;
+ my $op = '' ;
+ if ($name =~ /^(\+|\-)\s*(.*?)$/)
+ {
+ $op = $1 ;
+ $name = $2;
+ }
+ $name = "$oldname $name" if ($op eq '+') ;
+
+ my @split = split (/\s/, $name) ;
+ if ($op eq '-')
+ {
+ my @mnames = map { /::/?$_:'HTML::Embperl::Syntax::'. $_ } @split ;
+ foreach (@mnames)
+ {
+ $names{$_} = 1 ;
+ }
+ @split = split (/\s/, $oldname) ;
+ }
+
+ my @xnames = map { /::/?$_:'HTML::Embperl::Syntax::'. $_ } @split ;
+ my @names ;
+ foreach (@xnames)
+ {
+ push @names, $_ if (!$names{$_} && !(/^\s*$/)) ;
+ $names{$_} = 1 ;
+ }
+
$name = join (' ', @names) ;
+ print HTML::Embperl::LOG "SYNTAX: switch to $name\n" ;
+
return undef if (!$name) ;
return $Syntax{$name} if (exists ($Syntax{$name})) ;
@@ -1330,6 +1359,14 @@
=item 8
Set this node to ignore for output.
+
+=item 16
+
+Remove all child nodes
+
+=item 32
+
+Set all child nodes to ignore for output.
=back
No revision
No revision
1.1.2.10 +4 -4 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.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- EmbperlBlocks.pm 2001/03/22 09:04:51 1.1.2.9
+++ EmbperlBlocks.pm 2001/03/23 09:28:14 1.1.2.10
@@ -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.9 2001/03/22 09:04:51 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.10 2001/03/23 09:28:14 richter Exp $
#
###################################################################################
@@ -311,11 +311,11 @@
}) ;
$self -> AddMetaCmd ('syntax',
{
- compiletimeperlcode => '$_ep_req -> Syntax (HTML::Embperl::Syntax::GetSyntax(%&\'<noname>%));',
+ compiletimeperlcode => '$_[0] -> Syntax (HTML::Embperl::Syntax::GetSyntax(%&\'<noname>%, $_[0] -> SyntaxName));',
removenode => 3,
},
{
- parsetimeperlcode => '$_ep_req -> Syntax (HTML::Embperl::Syntax::GetSyntax(\'%%\')) ;',
+ parsetimeperlcode => '$_[0] -> Syntax (HTML::Embperl::Syntax::GetSyntax(\'%%\', $_[0] -> SyntaxName)) ;',
},
) ;
$self -> AddMetaCmdBlock ('sub', 'endsub',
@@ -328,7 +328,7 @@
switchcodetype => 2,
},
{
- perlcode => '}; sub %^subname% { my @_ep_save ; HTML::Embperl::Cmd::SubStart(\\$_ep_DomTree,%$q%,\\@_ep_save); my $_ep_ret = _ep_sub_%^subname% (@_); HTML::Embperl::Cmd::SubEnd(\\@_ep_save); return $_ep_ret } ; $_ep_req -> ExportHash -> {%^"subname%} = \&%^subname% ; ',
+ perlcode => '}; sub %^subname% { my @_ep_save ; HTML::Embperl::Cmd::SubStart(\\$_ep_DomTree,%$q%,\\@_ep_save); my $_ep_ret = _ep_sub_%^subname% (@_); HTML::Embperl::Cmd::SubEnd(\\@_ep_save); return $_ep_ret } ; $_[0] -> ExportHash -> {%^"subname%} = \&%^subname% ; ',
removenode => 10,
mayjump => 1,
pop2 => 'subname',
1.1.2.3 +3 -3 embperl/Embperl/Syntax/Attic/Perl.pm
Index: Perl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/Perl.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- Perl.pm 2001/03/20 08:01:55 1.1.2.2
+++ Perl.pm 2001/03/23 09:28:14 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Perl.pm,v 1.1.2.2 2001/03/20 08:01:55 richter Exp $
+# $Id: Perl.pm,v 1.1.2.3 2001/03/23 09:28:14 richter Exp $
#
###################################################################################
@@ -49,9 +49,9 @@
{
$self -> {-perlInit} = 1 ;
- $self -> AddInitCode (undef, '%#0% ;', undef,
+ $self -> AddInitCode (undef, '$_ep_node=%$x%; %#0% ;', undef,
{
- removenode => 3,
+ removenode => 32,
compilechilds => 0,
}) ;
1.1.2.8 +25 -11 embperl/Embperl/Syntax/Attic/SSI.pm
Index: SSI.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/SSI.pm,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- SSI.pm 2001/03/22 09:04:52 1.1.2.7
+++ SSI.pm 2001/03/23 09:28:14 1.1.2.8
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: SSI.pm,v 1.1.2.7 2001/03/22 09:04:52 richter Exp $
+# $Id: SSI.pm,v 1.1.2.8 2001/03/23 09:28:14 richter Exp $
#
###################################################################################
@@ -106,18 +106,21 @@
'_ep_rp(%$x%, HTML::Embperl::Syntax::SSI::include (%&\'file%, %&\'virtual%)) ;',
] } ) ;
$self -> AddComment ('#set', ['var', 'value'], undef, undef,
- { perlcode => '$ENV{%&*\'var%} = HTML::Embperl::Syntax::SSI::InterpretVars (%&\'value%) ;',
+ { perlcode => '%&value%',
+ compiletimeperlcode => '$_[0] -> Code (q{$ENV{%&*\'var%} = "} . HTML::Embperl::Syntax::SSI::InterpretVars (%&\'value%) . \'";\') ;',
removenode => 1
} ) ;
$self -> AddComment ('#if', ['expr'], undef, undef,
- { perlcode => 'if (HTML::Embperl::Syntax::SSI::InterpretVars (%&\'expr%)) { ',
+ { perlcode => '%&\'expr%',
+ compiletimeperlcode => '$_[0] -> Code (q{if (} . HTML::Embperl::Syntax::SSI::InterpretVars (%&\'expr%) . \') {\') ;',
removenode => 10,
mayjump => 1,
stackname => 'ssicmd',
'push' => 'if',
} ) ;
$self -> AddComment ('#elif', ['expr'], undef, undef,
- { perlcode => '} elsif (HTML::Embperl::Syntax::SSI::InterpretVars (%&\'expr%)) { ',
+ { perlcode => '%&\'expr%',
+ compiletimeperlcode => '$_[0] -> Code (\'} elsif (\' . HTML::Embperl::Syntax::SSI::InterpretVars (%&\'expr%) . \') {\') ;',
removenode => 10,
mayjump => 1,
stackname => 'ssicmd',
@@ -139,15 +142,24 @@
stackname => 'ssicmd',
stackmatch => 'if',
} ) ;
- $self -> AddComment ('#syntax', ['type'], undef, undef,
+ my $tag = $self -> AddComment ('#syntax', ['type'], undef, undef,
{
- compiletimeperlcode => '$_ep_req -> Syntax (HTML::Embperl::Syntax::GetSyntax(%&\'type%));',
+ compiletimeperlcode => '$_[0] -> Syntax (HTML::Embperl::Syntax::GetSyntax(%&\'type%, $_[0] -> SyntaxName));',
removenode => 3,
},
- {
- parsetimeperlcode => '$_ep_req -> Syntax (HTML::Embperl::Syntax::GetSyntax(\'%%\')) ;',
- },
) ;
+ my $ptcode = '$_[0] -> Syntax (HTML::Embperl::Syntax::GetSyntax(\'%%\', $_[0] -> SyntaxName)) ;' ;
+
+ if (!$self -> {-ssiAssignAttrType})
+ {
+ $self -> {-ssiAssignAttrType} = $self -> CloneHash ($self -> {-htmlAssignAttr}) ;
+ }
+ $tag -> {inside}{type}{'follow'} = $self -> {-ssiAssignAttrType} ;
+ $self -> {-ssiAssignAttrType}{Assign}{follow}{'Attribut ""'}{parsetimeperlcode} = $ptcode ;
+ $self -> {-ssiAssignAttrType}{Assign}{follow}{'Attribut \'\''}{parsetimeperlcode} = $ptcode ;
+ $self -> {-ssiAssignAttrType}{Assign}{follow}{'Attribut alphanum'}{parsetimeperlcode} = $ptcode ;
+
+
}
@@ -189,8 +201,10 @@
{
my $val = shift ;
- $val =~ s/\$(\w)([a-zA-Z0-9_]*)/$ENV{"$1$2"}/g ;
- $val =~ s/\$\{(\w)([a-zA-Z0-9_]*?)\}/$ENV{"$1$2"}/g ;
+ my $esc = shift ;
+ $val =~ s/\$(\w)([a-zA-Z0-9_]*)/\$ENV{'$1$2'}/g ;
+ $val =~ s/\$\{(\w)([a-zA-Z0-9_]*?)\}/\$ENV{'$1$2'}/g ;
+ $val =~ s/\'/\\\'/g if ($esc) ;
return $val ;
}
No revision
No revision
1.1.2.2 +1 -1 embperl/test/cmp/Attic/ssibasic.htm
Index: ssibasic.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/Attic/ssibasic.htm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- ssibasic.htm 2001/03/17 22:20:53 1.1.2.1
+++ ssibasic.htm 2001/03/23 09:28:15 1.1.2.2
@@ -75,7 +75,7 @@
if 2
EPSSITEST
if 3
-! EPSSITEST
+! NOT EPSSITEST
if 4
1
Some Embperl command that should _not_ executed here:
No revision
No revision
1.1.2.2 +43 -1 embperl/test/html/Attic/syntax.htm
Index: syntax.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/Attic/syntax.htm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- syntax.htm 2001/03/22 09:14:20 1.1.2.1
+++ syntax.htm 2001/03/23 09:28:15 1.1.2.2
@@ -1,4 +1,13 @@
+<html>
+<head>
+<title>Embperl Tests - Switch syntax</title>
+</head>
+
+<body>
+
+
+
--- syntax Default ---
[+ $a = 'embperl 1' +]
@@ -36,9 +45,39 @@
<!--#set var="a" value="ssi 1" -->
<!--#echo var="a" -->
+--- syntax - SSI = Embperl ---
+
+[$ syntax - SSI $]
+
+ [+ $a = 'embperl 1' +]
+
+ <!--#set var="a" value="ssi 1" -->
+ <!--#echo var="a" -->
+
+
+--- syntax + SSI = Embperl SSI ---
+
+[$ syntax + SSI $]
+
+ [+ $a = 'embperl 1' +]
+
+ <!--#set var="a" value="ssi 1" -->
+ <!--#echo var="a" -->
+
+
+--- syntax - Embperl = SSI ---
+
+[$ syntax - Embperl $]
+
+ [+ $a = 'embperl 1' +]
+
+ <!--#set var="a" value="ssi 1" -->
+ <!--#echo var="a" -->
+
+
--- syntax Text ---
-[$ syntax Text $]
+<!--#syntax type="Text" -->
[+ $a = 'embperl 1' +]
@@ -46,3 +85,6 @@
<!--#echo var="a" -->
+
+</body>
+</html>
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org