1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
proc show_and_tell {block} {
upvar page_content page_content
foreach line [split $block "\n"] {
if {[regsub {(?: )?(\S)} $line {\1} line]} {
append page_content "Executing: <tt>[ns_quotehtml $line]</tt><br>\n"
append page_content "Returns : <font color=green><tt>[ns_quotehtml [eval $line]]</tt></font><br><br>\n\n"
}
}
}
proc report_error {cmd} {
upvar page_content page_content
if {[catch {
set return_val [uplevel [list eval $cmd]]
} error]} {
return "Errored correctly, returning: $error"
} else {
error "Instead of erroring as expected, \"$cmd\" returned: $return_val"
}
}
#if {[catch {
show_and_tell {
set xml_string {<bloop><blop></blop><schism/><cantankerous moldy="true" flaky="false"/></bloop>}
set doc_id [ns_xml string parse xml $xml_string]
report_error {set doc_id [ns_xml string parse xml -validate $xml_string]}
set persist_doc_id [ns_xml string parse xml -persist $xml_string]
set new_doc_id [ns_xml create xml 1.1]
set new_persist_doc_id [ns_xml create xml -persist]
report_error {ns_xml create -persist}
ns_xml doc get root $doc_id
ns_xml doc get root $persist_doc_id
ns_xml doc get root $new_doc_id
report_error {ns_xml doc get root bloop}
set root [ns_xml doc create root $new_doc_id noodle {NOODLE TEXT}]
ns_xml doc render $new_doc_id
ns_xml doc delete $persist_doc_id
report_error {ns_xml doc render $persist_doc_id}
ns_xml doc delete $new_persist_doc_id
report_error {ns_xml doc get root $new_persist_doc_id}
set child_text [ns_xml node get children $root]
ns_xml node get parent $root
ns_xml node get parent $child_text
ns_xml node create child_node $child_text "normalnode" "Normal nodes don't display when placed inside text nodes"
set more_content [ns_xml node get children $child_text]
ns_xml doc render $new_doc_id
ns_xml node delete $more_content
ns_xml node get children $child_text
ns_xml node create child_text $child_text "Text nodes do display when nested within text nodes (note that they are displayed afterward)"
ns_xml doc render $new_doc_id
set third_node [ns_xml node create child_node $root {third_node} {This should appear third}]
set first_node [ns_xml node create prev_sibling_node $third_node {first_node} {This should appear first (prev siblings are inserted directly before the node referenced)}]
set second_node [ns_xml node create next_sibling_node $first_node {second_node} {This should appear second (next siblings appear directly after the node referenced)}]
set fourth_node [ns_xml node create child_node $root {fourth_node} {This should appear fourth (child nodes are inserted as a new last sibling)}]
ns_xml node create next_sibling_text $first_node {i'm between the first and the second}
ns_xml node create prev_sibling_text $third_node {i'm between the second and third}
ns_xml node create next_sibling_text $third_node {i'm between the third and fourth}
ns_xml node create child_text $root {i'm after all four}
ns_xml doc render $new_doc_id
set dup_node [ns_xml node clone $root]
ns_xml doc render $new_doc_id
ns_xml node relink_as child $dup_node [set schism [lindex [ns_xml node get children [ns_xml node get children [ns_xml doc get root $doc_id]]] 1]]
ns_xml doc render $new_doc_id
ns_xml doc render $doc_id
set third_node [ns_xml node relink_as prev_sibling $third_node $first_node]
set fourth_node [ns_xml node relink_as next_sibling $fourth_node $third_node]
set first_node [ns_xml node relink_as prev_sibling $first_node $third_node]
set second_node [ns_xml node relink_as next_sibling $second_node $first_node]
foreach node {first_node second_node third_node fourth_node} {ns_xml node delete [ns_xml node get children [set $node]]}
ns_xml node set attr $root humble bumble
ns_xml doc render $new_doc_id
foreach node [ns_xml node get children $root] {ns_xml node delete $node}
ns_xml node get attr $root humble
ns_xml node unset attr $root humble
ns_xml doc render $new_doc_id
ns_xml node get name $root
ns_xml node get type $root
ns_xml node set content $root "grope"
ns_xml node get content $root
ns_xml node render $schism
# Test the 1.x API
set doc_id [ns_xml parse -persist $xml_string]
ns_xml doc free $doc_id
report_error {ns_xml parse -persist -validate $xml_string}
set root [ns_xml doc root [set doc_id [ns_xml parse -persist $xml_string]]]
set root [ns_xml doc new_root $doc_id {Tag} {value}]
ns_xml node setattr $root blip blipp
ns_xml node getattr $root blip
set node [ns_xml node new_child $root {more} {morecontent}]
ns_xml node new_sibling $node {siblingnode} {siblingcontent}
ns_xml node getcontent $node
ns_xml node setcontent $node "siblingcontentrevision2"
ns_xml node children $root
ns_xml node name $root
ns_xml node type $root
ns_xml doc render $doc_id
ns_xml doc free $doc_id
}
#} error]} {
# ns_return 200 text/html "<html><head><title>Error</title></head><body bgcolor=FFFFFF>
#<h2>Error</h2>
#<code>ns_xml</code> 2.0 is either not installed or broken.
#<hr>
#<address><a href=mailto:jmileham@berklee.edu>jmileham@berklee.edu</a></address>
#</body>
#</html>
#"
#} else {
ns_return 200 text/html "
<html>
<head><title>Success!</title></head>
<body bgcolor=#FFFFFF>
<h2>Success</h2>
<code>ns_xml</code> 2.0 is installed correctly and working properly, providing full backwards compatibility with 1.x.
<hr>
Results of tests:
<blockquote>
<font size=-2>
$page_content
</font>
</blockquote>
<hr>
<address><a href=mailto:jmileham@berklee.edu>jmileham@berklee.edu</a></address>
</body>
</html>
"
#}
|
