You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@tcl.apache.org by mx...@apache.org on 2018/11/04 14:49:58 UTC
[tcl-rivet] 04/04: new form of ::rivet::xml and related test and
documentation
This is an automated email from the ASF dual-hosted git repository.
mxmanghi pushed a commit to branch 3.0
in repository https://gitbox.apache.org/repos/asf/tcl-rivet.git
commit 9fd79a4c41af76fb904a1506dbcc322a7c41ff15
Author: Massimo Manghi <mx...@apache.org>
AuthorDate: Sun Nov 4 15:49:35 2018 +0100
new form of ::rivet::xml and related test and documentation
---
ChangeLog | 9 ++++++
doc/xml/commands.xml | 23 ++++++++++++++--
rivet/rivet-tcl/xml.tcl | 73 +++++++++++++++++++++++++++++++++++++++++++------
tests/commands.tcl | 34 +++++++++++++++++++++++
tests/commands.test | 16 +++++++++++
tests/rivet.test | 4 +--
tests/runtests.tcl | 1 +
7 files changed, 145 insertions(+), 15 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 853958b..5b8daee 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,15 @@
+2018-11-04 Massimo Manghi <mx...@apache.org>
+ * rivet/rivet-tcl/xml.tcl: New ::rivet::xml command simplified and
+ new construct for self closing elements
+ * doc/xml/commands.xml: documenting new ::rivet::xml command
+ * tests/commands.[test|tcl]: add new test for commands that don't need
+ their own test script
+ * tests/runtest.tcl: Now is supposed to load 'prefork' by default
+
2018-11-02 Massimo Manghi <mx...@apache.org>
* rivet/packages/dio/: integrating changes done in the master branch.
Basically fully qualifying commands that need the ::rivet namespace
+
2018-08-07 Massimo Manghi <mx...@apache.org>
* rivet/init.tcl: reflecting the changes in init.tcl.in
* doc/rivet.xml: removed subversion related keyword
diff --git a/doc/xml/commands.xml b/doc/xml/commands.xml
index 60dcfd1..4971cbf 100644
--- a/doc/xml/commands.xml
+++ b/doc/xml/commands.xml
@@ -2,7 +2,7 @@
<title>Rivet Tcl Commands and Variables</title>
<section>
<para>
- Starting with version 2.1.0 Rivet command set moved into the
+ Starting with version 2.1.0 the Rivet command set moved into the
<command>::rivet</command> namespace.
</para>
<para>
@@ -2111,12 +2111,29 @@ form_request end</programlisting>
<programlisting>::rivet::xml "a string" b u
<== <b><u>a string</u></b></programlisting>
<para>
- You can tell the tags which attributes they must have
+ You can specify the tags attributes by replacing a tag specification
+ with a odd-length list containing the tag name and a series of
+ attribute-value pairs
</para>
<programlisting><command>::rivet::xml "a string" [list div class box id testbox] b i</command>
<== <div class="box" id="testbox"><b><i>a string</i></b></div></programlisting>
- <programlisting><command>::rivet::xml "text to be wrapped in XML" div [list a href "http://..../" title "info message"]</command>
+ <programlisting><command>::rivet::xml "text to be wrapped in XML" div [list a href http://..../ title "info message"]</command>
<== <div><a href="http://..../" title="info message">text to be wrapped in XML</a></div></programlisting>
+ <para>
+ A single argument is interpreted as a list of tag name and attributes to be
+ coded as a self closing element
+ </para>
+ <programlisting><command>::rivet::xml [list b a1 v1 a2 v2]</command>
+<== <b a1="v1" a2="v2" /></programlisting>
+ <para>
+ Unless the string is literally an empty string
+ </para>
+ <programlisting><command>::rivet::xml "" [list b a1 v1 a2 v2]</command>
+<== <b a1="v1" a2="v2"></b></programlisting>
+ <para>which is useful for generating 'script' elements in an HTML page header that wouldn't be understood
+ as single closing element</para>
+ <programlisting><command>::rivet::xml "" [list script type "text/javascript" src js/myscripts.js]</command>
+<== <script type="text/javascript" src="js/myscripts.js"></script></programlisting>
</refsect1>
</refentry>
</section>
diff --git a/rivet/rivet-tcl/xml.tcl b/rivet/rivet-tcl/xml.tcl
index 2a18bc8..13a2d1b 100644
--- a/rivet/rivet-tcl/xml.tcl
+++ b/rivet/rivet-tcl/xml.tcl
@@ -1,36 +1,71 @@
#
-# xml.tcl string ?tag ?attr val? ?attr val?? ?tag ?attr val? ?attr val??
+# xml.tcl --
+#
+# Syntax:
+#
+# ::rivet::xml string ?tag ?attr val? ?attr val?? ?tag ?attr val? ?attr val??
+#
+# or
+#
+# ::rivet::xml ?tag ?attr val? ?attr val??
#
# Example 1:
#
+# trivial nested markup fragment
+#
# ::rivet::xml Test b i
-# <== <b><i>Test</i></b>
+# <= <b><i>Test</i></b>
#
# Example 2:
#
+# XHTML Element with attributes
+#
# ::rivet::xml Test [list div class box id testbox] b i
-# <== <div class="box" id="testbox"><b><i>Test</i></b></div>
+# <= <div class="box" id="testbox"><b><i>Test</i></b></div>
#
# Example 3
#
# ::rivet::xml "anything ..." div [list a href "http://..../" title "info message"]
-# <== <div><a href="http://..../" title="info message">anything ...</a></div>
+# <= <div><a href="http://..../" title="info message">anything ...</a></div>
+#
+# Example 4
+#
+# ::rivet::xml "" [list a attr1 val1 attr2 val2] [list b attr1 val1 attr2 val2]
+# <= <a attr1="val1" attr2="val2"><b attr1="val1" attr2="val2"></b></a>
#
-# $Id$
+# Example 5
+#
+# single self closing element
+#
+# ::rivet::xml [list a attr1 val1 attr2 val2]
+# <= <a attr1="val1" attr2="val2" />
#
namespace eval ::rivet {
proc xml {textstring args} {
- set xmlout ""
- set tags_stack {}
+ set single_element [::rivet::lempty $args]
+ if {$single_element} {
+
+ set tags_list [list $textstring]
+
+ if {[::rivet::lempty $tags_list]} { return "" }
+
+ } else {
- foreach el $args {
+ set tags_list $args
+
+ }
+
+ set tags_stack {}
+ set el {}
+ set xmlout ""
+ foreach el $tags_list {
set el [lassign $el tag]
lappend tags_stack $tag
- append xmlout "<$tag"
+ append xmlout "<$tag"
foreach {attrib attrib_v} $el {
append xmlout " $attrib=\"$attrib_v\""
@@ -39,10 +74,30 @@ namespace eval ::rivet {
append xmlout ">"
}
+
if {[::rivet::lempty $tags_stack]} {
+
return $textstring
+
+ } elseif {$single_element} {
+
+ # variable 'el' keeps the last (innermost) attribute-value list
+
+ if {[::rivet::lempty $el] == 1} {
+ set xmlout [string replace $xmlout end end " />"]
+ } else {
+ set xmlout [string replace $xmlout end end "/>"]
+ }
+
+ if {[llength $tags_stack] > 1} {
+ set xmlout [append xmlout "</[join [lreverse [lrange $tags_stack 0 end-1]] "></"]>"]
+ }
+ return $xmlout
+
} else {
+
return [append xmlout "$textstring</[join [lreverse $tags_stack] "></"]>"]
+
}
}
diff --git a/tests/commands.tcl b/tests/commands.tcl
index e69de29..db06f97 100644
--- a/tests/commands.tcl
+++ b/tests/commands.tcl
@@ -0,0 +1,34 @@
+# -- commands.tcl
+#
+# testing the output of various commands that
+# provide a swiss knife for formatting, generating, etc.etc.
+#
+
+
+if {[::rivet::var exists cmd]} {
+
+ set cmd [::rivet::var get cmd]
+ switch $cmd {
+ xml {
+
+ # generic ::rivet::xml usage
+
+ puts [::rivet::xml "a text string" a [list b a1 v1 a2 v2] [list c a1 v1 a2 v2]]
+ puts [::rivet::xml "a text string" [list b a1 v1 a2 v2] [list c a1 v1 a2 v2] a]
+ puts [::rivet::xml "" [list b a1 v1 a2 v2] [list c a1 v1 a2 v2] a]
+
+ # self closing single element
+
+ puts [::rivet::xml [list a a1 v1 a2 v2]]
+ puts -nonewline [::rivet::xml br]
+ }
+ default {
+ puts "invalid argument '$cmd'"
+ }
+ }
+
+} else {
+
+ puts "no cmd argument provided"
+
+}
diff --git a/tests/commands.test b/tests/commands.test
index e69de29..a770583 100644
--- a/tests/commands.test
+++ b/tests/commands.test
@@ -0,0 +1,16 @@
+# -- commands.test
+#
+# Tcl commands suite tests
+#
+# Testing the output of various commands that
+# provide a swiss knife for formatting, generating, etc.etc.
+#
+
+::tcltest::test tcl-xml-1.1 {::rivet::xml command} {
+ set page [::http::geturl "${urlbase}commands.tcl?cmd=xml"]
+ ::http::data $page
+} {<a><b a1="v1" a2="v2"><c a1="v1" a2="v2">a text string</c></b></a>
+<b a1="v1" a2="v2"><c a1="v1" a2="v2"><a>a text string</a></c></b>
+<b a1="v1" a2="v2"><c a1="v1" a2="v2"><a></a></c></b>
+<a a1="v1" a2="v2"/>
+<br />}
diff --git a/tests/rivet.test b/tests/rivet.test
index 3a83957..fade49a 100755
--- a/tests/rivet.test
+++ b/tests/rivet.test
@@ -6,8 +6,6 @@
# See README file for more information.
-# $Id$
-
package require tcltest
set auto_path [linsert $auto_path 0 [file join [pwd] rivet]]
@@ -18,7 +16,7 @@ set urlbase "http://localhost:8081/"
set TestList {rivetlib.test shorthand.test headers.test \
cookies.test get.test post.test tclfile.test \
env.test hello.test include.test binary.test \
- parse.test upload.test makeurl.test}
+ parse.test upload.test makeurl.test commands.test}
# Test stanzas are created by giving the test a name and a
# description. The code is then executed, and the results compared
diff --git a/tests/runtests.tcl b/tests/runtests.tcl
index 31d95a5..eaa9ee0 100755
--- a/tests/runtests.tcl
+++ b/tests/runtests.tcl
@@ -80,6 +80,7 @@ apachetest::need_modules {
{mod_authz_core authz_core_module}
{mod_authz_host authz_host_module}
{mod_unixd unixd_module}
+ {mod_mpm_prefork mpm_prefork_module}
}
apachetest::makeconf server.conf {
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@tcl.apache.org
For additional commands, e-mail: commits-help@tcl.apache.org