richter 01/05/06 05:39:07
Modified: . Tag: Embperl2c Embperl.pm epcomp.c epdom.c
epparse.c test.pl
Embperl Tag: Embperl2c Syntax.pm
Embperl/Syntax Tag: Embperl2c RTF.pm
test/html/rtf Tag: Embperl2c rtfbasic.asc
Log:
Embperl 2 - RTF syntax cont.
Revision Changes Path
No revision
No revision
1.118.4.36 +8 -1 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.35
retrieving revision 1.118.4.36
diff -u -r1.118.4.35 -r1.118.4.36
--- Embperl.pm 2001/05/04 06:14:45 1.118.4.35
+++ Embperl.pm 2001/05/06 12:39:03 1.118.4.36
@@ -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.35 2001/05/04 06:14:45 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.36 2001/05/06 12:39:03 richter Exp $
#
###################################################################################
@@ -1117,6 +1117,7 @@
my $cgi ;
my $ioType ;
my %req ;
+ my @param ;
ScanEnvironment (\%req) ;
@@ -1134,6 +1135,11 @@
shift @$args ;
$req{'outputfile'} = shift @$args ;
}
+ if ($$args[0] eq '-p')
+ {
+ shift @$args ;
+ push @param, shift @$args ;
+ }
elsif ($$args[0] eq '-l')
{
shift @$args ;
@@ -1192,6 +1198,7 @@
$req{'cleanup'} = 0 ;
$req{'cleanup'} = -1 if (($req{'options'} & optDisableVarCleanup)) ;
$req{'options'} |= optSendHttpHeader ;
+ $req{'param'} = \@param ;
$rc = Execute (\%req) ;
1.4.2.50 +3 -1 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.49
retrieving revision 1.4.2.50
diff -u -r1.4.2.49 -r1.4.2.50
--- epcomp.c 2001/05/04 14:04:19 1.4.2.49
+++ epcomp.c 2001/05/06 12:39:03 1.4.2.50
@@ -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.49 2001/05/04 14:04:19 richter Exp $
+# $Id: epcomp.c,v 1.4.2.50 2001/05/06 12:39:03 richter Exp $
#
###################################################################################*/
@@ -932,6 +932,8 @@
{
r -> pCodeSV = newSVpv (pCode, nCodeLen) ;
}
+ else
+ r -> pCodeSV = &sv_undef ;
if ((rc = EvalDirect (r, pSV, 1, args)) != ok)
LogError (r, rc) ;
SvREFCNT_dec(pSV);
1.4.2.35 +94 -43 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.34
retrieving revision 1.4.2.35
diff -u -r1.4.2.34 -r1.4.2.35
--- epdom.c 2001/05/02 12:14:13 1.4.2.34
+++ epdom.c 2001/05/06 12:39:04 1.4.2.35
@@ -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.34 2001/05/02 12:14:13 richter Exp $
+# $Id: epdom.c,v 1.4.2.35 2001/05/06 12:39:04 richter Exp $
#
###################################################################################*/
@@ -2290,63 +2290,114 @@
{
int n = pNode -> numAttr ;
struct tAttrData * pAttr = (struct tAttrData *)(pNode + 1) ;
-
- if (pNode -> nType == ntypStartTag)
- pLastStartTag = pNode ;
-
- oputc (r, '<') ;
- oputs (r, Node_selfNodeName (pNode)) ;
+ char * pNodeName = Node_selfNodeName (pNode) ;
+ char * pNodeStart ;
+ char * pNodeEnd ;
+ int nNodeStartLen ;
+ int nNodeEndLen ;
+ int nLastLen ;
- while (n--)
+ if (*pNodeName)
{
- if (pAttr -> bFlags)
+ if (*pNodeName == ':')
{
- char * s ;
- int l ;
- oputc (r, ' ') ;
- if (pAttr -> xName != xNoName)
+ pNodeStart = ++pNodeName ;
+ nNodeStartLen = 0 ;
+ nNodeEndLen = 0 ;
+ while (*pNodeName && *pNodeName != ':')
+ {
+ nNodeStartLen++ ;
+ pNodeName++ ;
+ }
+ if (*pNodeName == ':')
{
- Ndx2StringLen (pAttr -> xName,s,l) ;
- owrite (r, s, l);
+ pNodeEnd = ++pNodeName ;
+ while (*pNodeName && *pNodeName != ':')
+ {
+ nNodeEndLen++ ;
+ pNodeName++ ;
+ }
}
+ if (*pNodeName == ':')
+ pNodeName++ ;
+ }
+ else
+ {
+ pNodeStart = "<" ;
+ pNodeEnd = ">" ;
+ nNodeStartLen = 1 ;
+ nNodeEndLen = 1 ;
+ }
- if (pAttr -> xValue)
+
+ if (pNode -> nType == ntypStartTag)
+ pLastStartTag = pNode ;
+
+ owrite (r, pNodeStart, nNodeStartLen) ;
+ oputs (r, pNodeName) ;
+ if (*pNodeName)
+ nLastLen = 1 ;
+ else
+ nLastLen = 0 ;
+
+ while (n--)
+ {
+ if (pAttr -> bFlags)
{
+ char * s ;
+ int l ;
+ if (nLastLen)
+ {
+ oputc (r, ' ') ;
+ nLastLen = 0 ;
+ }
if (pAttr -> xName != xNoName)
- if (pAttr -> bFlags & aflgSingleQuote)
- oputs (r, "='") ;
- else
- oputs (r, "=\"") ;
-
- if (pAttr -> bFlags & aflgAttrChilds)
{
- tAttrData * pAttrNode = (tAttrData * )Node_toString2
(pDomTree, r, pAttr -> xNdx, &nOrderNdx) ;
- if (pAttrNode && pAttrNode != pAttr)
- {
- pAttr = pAttrNode ;
- pNode = Attr_selfNode(pAttr) ;
- n = pNode -> numAttr - Attr_selfAttrNum (pAttr) - 1
;
- if (n < 0)
- n = 0 ;
- }
+ Ndx2StringLen (pAttr -> xName,s,l) ;
+ owrite (r, s, l);
+ nLastLen += l ;
}
- else
+
+ if (pAttr -> xValue)
{
- Ndx2StringLen (pAttr -> xValue, s, l) ;
- while (isspace (*s) && l > 0)
- s++, l-- ;
- owrite (r, s, l) ;
+ if (pAttr -> xName != xNoName)
+ if (pAttr -> bFlags & aflgSingleQuote)
+ oputs (r, "='") ;
+ else
+ oputs (r, "=\"") ;
+
+ if (pAttr -> bFlags & aflgAttrChilds)
+ {
+ tAttrData * pAttrNode = (tAttrData * )Node_toString2
(pDomTree, r, pAttr -> xNdx, &nOrderNdx) ;
+ if (pAttrNode && pAttrNode != pAttr)
+ {
+ pAttr = pAttrNode ;
+ pNode = Attr_selfNode(pAttr) ;
+ n = pNode -> numAttr - Attr_selfAttrNum (pAttr) -
1 ;
+ if (n < 0)
+ n = 0 ;
+ }
+ nLastLen++ ;
+ }
+ else
+ {
+ Ndx2StringLen (pAttr -> xValue, s, l) ;
+ while (isspace (*s) && l > 0)
+ s++, l-- ;
+ owrite (r, s, l) ;
+ nLastLen += l ;
+ }
+ if (pAttr -> xName != xNoName)
+ if (pAttr -> bFlags & aflgSingleQuote)
+ oputc (r, '\'') ;
+ else
+ oputc (r, '"') ;
}
- if (pAttr -> xName != xNoName)
- if (pAttr -> bFlags & aflgSingleQuote)
- oputc (r, '\'') ;
- else
- oputc (r, '"') ;
}
+ pAttr++ ;
}
- pAttr++ ;
+ owrite (r, pNodeEnd, nNodeEndLen) ;
}
- oputc (r, '>') ;
}
else if (pNode -> nType == ntypText)
{
1.4.2.23 +9 -5 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.22
retrieving revision 1.4.2.23
diff -u -r1.4.2.22 -r1.4.2.23
--- epparse.c 2001/05/04 14:04:27 1.4.2.22
+++ epparse.c 2001/05/06 12:39:04 1.4.2.23
@@ -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.22 2001/05/04 14:04:27 richter Exp $
+# $Id: epparse.c,v 1.4.2.23 2001/05/06 12:39:04 richter Exp $
#
###################################################################################*/
@@ -371,7 +371,7 @@
for (i = 0; i < n; i++)
{
- if (pTable[i].pContains)
+ if (pTable[i].pContains && !pTable[i].sText[0])
pTokenTable -> pContainsToken = &pTable[i] ;
if (pTable[i].pEndTag)
{
@@ -607,16 +607,20 @@
if (pToken -> nNodeType != ntypCDATA)
while (isspace (*pCurr))
pCurr++ ;
-
- if (pToken -> sNodeName)
+
+ if (pToken -> sNodeName)
pNodeName = pToken -> sNodeName ;
}
else
{
pToken = pNextTokenTab -> pContainsToken ;
+ if (pToken && pToken -> sNodeName)
+ pNodeName = pToken -> sNodeName ;
break ;
}
- }
+
+
+ }
while (pNextTokenTab = pToken -> pFollowedBy) ;
if (pToken)
1.70.4.54 +5 -1 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.53
retrieving revision 1.70.4.54
diff -u -r1.70.4.53 -r1.70.4.54
--- test.pl 2001/05/04 14:04:31 1.70.4.53
+++ test.pl 2001/05/06 12:39:04 1.70.4.54
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.53 2001/05/04 14:04:31 richter Exp $
+# $Id: test.pl,v 1.70.4.54 2001/05/06 12:39:04 richter Exp $
#
###################################################################################
@@ -36,7 +36,9 @@
# compartment =>
# cookie =>
# condition =>
+# param =>
+
@testdata = (
'ascii' => { },
'pure.htm' => {
@@ -576,6 +578,7 @@
'rtf/rtfbasic.asc' => {
'version' => 2,
'syntax' => 'RTF',
+ 'param' => { one => 1, hash => { a => 111, b => 222, c =>
[1111,2222,3333,4444]}, array => [11,22,33] },
},
) ;
@@ -1333,6 +1336,7 @@
@testargs = ( '-o', $outfile ,
'-l', $logfile,
'-d', $debug,
+ ($test->{param}?('-p', $test->{param}):()),
$page, $test -> {query_info} || '') ;
unshift (@testargs, 'dbgbreak') if ($opt_dbgbreak) ;
No revision
No revision
1.1.4.35 +8 -2 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.34
retrieving revision 1.1.4.35
diff -u -r1.1.4.34 -r1.1.4.35
--- Syntax.pm 2001/05/02 19:12:43 1.1.4.34
+++ Syntax.pm 2001/05/06 12:39:06 1.1.4.35
@@ -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.34 2001/05/02 19:12:43 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.35 2001/05/06 12:39:06 richter Exp $
#
###################################################################################
@@ -571,7 +571,9 @@
=item 'cdatatype' => ntypAttrValue
-Type of nodes for data inside this node.
+Type of nodes for data (which is not matched by 'inside' definitions) inside
+this node. Set to zero to not generate any nodes for text inside of this node,
+other then these that are matched by a 'inside' definition.
=item 'endtag'
@@ -702,6 +704,10 @@
Code that is executed at compile time. You can also specify a arrayref of string.
The first string which contains matching attributes are used.
The same special strings are replaced as in C<perlcode>.
+
+C<$_[0]> contains the Embperl request object. The method C<Code> can be used to
+get or set the perl code that should be generated by this node.
+
=item perlcoderemove => 0/1
No revision
No revision
1.1.2.5 +51 -15 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.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- RTF.pm 2001/05/04 14:04:49 1.1.2.4
+++ RTF.pm 2001/05/06 12:39:06 1.1.2.5
@@ -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.4 2001/05/04 14:04:49 richter Exp $
+# $Id: RTF.pm,v 1.1.2.5 2001/05/06 12:39:06 richter Exp $
#
###################################################################################
@@ -54,7 +54,8 @@
$self -> AddToRoot ($self -> {-rtfBlocks}) ;
- $self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF field'}{'follow'}{'RTF
fieldstart'}{'follow'}{'RTF block cmd'}{'follow'} ;
+ #$self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF field'}{'follow'}{'RTF
fieldstart'}{'follow'}{'RTF block cmd'}{'follow'} ;
+ $self -> {-rtfCmds} = $self -> {-rtfBlocks}{'RTF field'}{'inside'}{'RTF
fieldstart'}{'inside'}{'RTF block cmd'}{'follow'} ;
Init ($self) ;
}
@@ -189,11 +190,11 @@
}) ;
$self -> AddRTFCmd ('DOCVARIABLE',
{
- perlcode => '_ep_rp(%$x%,scalar(',
- perlcodeend => '));',
+ perlcode => '_ep_rp(%$x%,scalar(join(\'\',',
+ perlcodeend => ')));',
},
{
- 'removenode' => 4,
+ #'removenode' => 4,
'inside' => \%Var,
'cdatatype' => 0,
}
@@ -320,23 +321,46 @@
) ;
+sub Var2Code
+ {
+ my $var = shift ;
+ my @parts = split (/\./, $var) ;
+ my $code = '$param[0]' ;
+
+ foreach (@parts)
+ {
+ if (/^\d+/)
+ { $code .= "[$_]" }
+ else
+ { $code .= "{$_}" }
+ }
+ return $code ;
+ }
+
+
%Var = (
'-lsearch' => 1,
'Varname' =>
{
'contains' =>
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789.',
#'inside' => \%Varseparator,
- 'inside' => \%Varinside,
- 'cdatatype' => 0,
- 'nodename' => 'full_var',
+ #'inside' => \%Varinside,
+ 'cdatatype' => ntypTag,
+ 'nodename' => ':{:}:full_var',
'procinfo' => {
'embperl' => {
- perlcode => '$param[0]',
+ compiletimeperlcode => q[$_[0] -> Code
(HTML::Embperl::Syntax::RTF::Var2Code (%#'0%)) ;],
},
},
- }
+ },
+ 'VarnameComment' =>
+ {
+ text => '\\\\*',
+ 'cdatatype' => 0,
+ 'contains' =>
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789.',
+ },
) ;
@@ -346,6 +370,7 @@
{
text => '//*',
'cdatatype' => 0,
+ 'contains' =>
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789.',
}
) ;
@@ -357,6 +382,8 @@
'text' => '{',
'end' => '}',
'unescape' => 1,
+ 'cdatatype' => ntypAttrValue,
+ #'nodename' => '',
'follow' => {},
},
) ;
@@ -374,8 +401,14 @@
'RTF fieldstart' => {
'text' => '{\*\fldinst',
'end' => '}',
- 'unescape' => 1,
- 'follow' => \%CmdStart,
+ 'nodename' => ':',
+ 'cdatatype' => ntypAttrValue,
+ 'inside' => \%CmdStart,
+ },
+ 'RTF fieldend' => {
+ 'text' => '{\fldrslt',
+ 'end' => '}',
+ 'nodename' => '',
},
) ;
@@ -386,14 +419,17 @@
'RTF block' => {
'text' => '{',
'end' => '}',
- 'unescape' => 1,
+ 'nodename' => ':{:}:',
+ 'cdatatype' => ntypAttrValue,
+ #'forcetype' => ntypAttrValue,
'inside' => \%Block,
},
'RTF field' => {
'text' => '{\field',
'end' => '}',
- 'unescape' => 1,
- 'follow' => \%FieldStart,
+ 'nodename' => ':{:}:',
+ 'cdatatype' => ntypAttrValue,
+ 'inside' => \%FieldStart,
},
'RTF escape open' => {
'text' => '\\{',
No revision
No revision
1.1.2.4 +5 -5 embperl/test/html/rtf/Attic/rtfbasic.asc
Index: rtfbasic.asc
===================================================================
RCS file: /home/cvs/embperl/test/html/rtf/Attic/rtfbasic.asc,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- rtfbasic.asc 2001/05/04 14:05:00 1.1.2.3
+++ rtfbasic.asc 2001/05/06 12:39:06 1.1.2.4
@@ -1,6 +1,6 @@
-{Param[0]: }{\field{\*\fldinst { DOCVARIABLE abc \\* MERGEFORMAT }}{\fldrslt }}
-{Param[0]: }{\field{\*\fldinst { DOCVARIABLE a.b.c \\* MERGEFORMAT }}{\fldrslt }}
-{Param[1]: }{\field{\*\fldinst { DOCVARIABLE a.1.c }}{\fldrslt }}
+{Param[0]: }{\field{\*\fldinst { DOCVARIABLE one \\* MERGEFORMAT }}{\fldrslt }}
+{Param[0]: }{\field{\*\fldinst { DOCVARIABLE hash.b \\* MERGEFORMAT }}{\fldrslt }}
+{Param[1]: }{\field{\*\fldinst { DOCVARIABLE array.2 }}{\fldrslt }}
-{Param[0]: }{\field{\*\fldinst { DOCVARIABLE $param[0] \\* MERGEFORMAT }}{\fldrslt
}}
-{Param[1]: }{\field{\*\fldinst { DOCVARIABLE $param[1] }}{\fldrslt }}
\ No newline at end of file
+{Param[0]: }{\field{\*\fldinst { DOCVARIABLE hash.c.2 \\* MERGEFORMAT }}{\fldrslt }}
+{Param[1]: }{\field{\*\fldinst { DOCVARIABLE hash.c.3 }}{\fldrslt }}
\ No newline at end of file
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
