# return 1 (true) if strings are equal
proc string_equal_p {str1 str2} {
if {[string compare $str1 $str2] == 0} {
return 1
}
return 0
}
# return 1 (true) if the string empty
proc empty_string_p {str} {
if { [string length $str] == 0 } {
return 1
} else {
return 0
}
}
# stolen from ACS 3x
# return HTML text that can be inserted into HTML (by
# qutoing special HTML chars)
proc ad_quotehtml { arg } {
# we have to do & first or we'll hose ourselves with the ones lower down
regsub -all & $arg \\&\; arg
regsub -all \" $arg \\"\; arg
regsub -all < $arg \\<\; arg
regsub -all > $arg \\>\; arg
return $arg
}
# dump a node of an XML doc
proc dump_node {node_id level} {
set name [ns_xml node name $node_id]
set type [ns_xml node type $node_id]
set content [ns_xml node getcontent $node_id]
if { $level > 0 } {
ns_write "
"
}
if { $level == 0 } {
ns_write "root node id=$node_id name=$name "
} else {
ns_write "node id=$node_id name=$name "
}
ns_write "type=$type "
# if a node is an ATTRIBUTE I would like to get the names and values of
# attributes but it isn't possible. You need to know the name of the
# attribute up-front
if { ![string_equal_p $type "attribute"] && ![string_equal_p $type "element"] } {
ns_write "content=$content\n"
}
}
# recursively dump the tree of an XML doc
proc dump_tree_rec {children level} {
if { $level > 0 } {
ns_write "
\n"
}
foreach child_id $children {
dump_node $child_id $level
set new_children [ns_xml node children $child_id]
if { [llength $new_children] > 0 } {
dump_tree_rec $new_children [expr $level + 1]
}
}
if { $level > 0 } {
ns_write "
\n"
}
}
# dump XML document
proc dump_doc {doc_id} {
ns_write "doc id=$doc_id \n"
set root_id [ns_xml doc root $doc_id]
dump_tree_rec [list $root_id] 0
}
# return HTML code for the textarea for submitting
# XML documents
proc get_form_html_code {} {
return "
"
}
# beginning of the real stuff
set form_data [ns_getform]
# what we'll show if nothing has been provided
set default_xml_doc "this is a test of xml and blopperhelloand another test"
# an example of XML file from linuxtoday.com headlines
set linuxtoday_xml_doc "Kernel Cousin Debian Hurd #73 By Paul Emsley And Zack Brownhttp://linuxtoday.com/news_story.php3?ltsn=2000-12-28-001-04-OS-DBmartyOpen Source,Debian0Zope 2.2.5 b1 releasedhttp://linuxtoday.com/news_story.php3?ltsn=2000-12-27-006-04-OS-SWmartyOpen Source,Software0
"
# parse either submitted data or default simple example
# or example of linuxtoday.com XML headlines file
if { $form_data != "" } {
set xml_doc [ns_set get $form_data "xml_doc"]
if { $xml_doc == "" } {
if { [ns_set get $form_data "show_linuxtoday_p"] == "1" } {
set xml_doc $linuxtoday_xml_doc
} else {
set xml_doc $default_xml_doc
}
}
} else {
set xml_doc $default_xml_doc
}
# generate HTTP headers
ns_write "HTTP/1.0 200 OK
MIME-Version: 1.0
Content-Type: text/html\n\n"
# now generate HTML text of the document
ns_write "
Test of xml
Testing XML parsing in AOLserver
\n"
if { [catch {set doc_id [ns_xml parse $xml_doc]} err] } {
ns_write "There was an error parsing the following XML document:
\n"
ns_write [ad_quotehtml $xml_doc]
ns_write "\n
Error message is:
\n"
ns_write [ad_quotehtml $err]
ns_write "\n
"
ns_write "\n"
return
}
ns_write "The following XML document: