Index: openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl,v
diff -u -N -r1.34 -r1.35
--- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 17 May 2003 09:40:20 -0000 1.34
+++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 29 May 2003 18:49:33 -0000 1.35
@@ -3,11 +3,8 @@
#
# Ben Adida (ben@mit.edu)
#
-# STATE OF THIS FILE (7/12/2001) - ben:
-# This is now patched to use ns_xml 1.4 which works!
-
# The Query Dispatcher is documented at http://openacs.org/
-# The Query Dispatcher needs ns_xml to work.
+# The Query Dispatcher needs tDOM (http://tdom.org) to work.
# This doesn't use the ad_proc construct, or any significant aD constructs,
# because we want this piece to be usable in a separate context. While this makes
@@ -24,7 +21,8 @@
Query Dispatching for multi-RDBMS capability
@author Ben Adida (ben@openforce.net)
- @cvs-id $Id$
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
+ @cvs-id $Id$
}
}
@@ -829,7 +827,7 @@
set querytext_close_len [string length $querytext_close]
# We're going to ns_quotehtml the querytext,
- # because ns_xml will choke otherwise
+ # because XML parsing might choke otherwise
while {1} {
set first_querytext_open [string first $querytext_open $rest_of_file_content]
set first_querytext_close [string first $querytext_close $rest_of_file_content]
Index: openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl,v
diff -u -N -r1.12 -r1.13
--- openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 13 Mar 2003 20:24:00 -0000 1.12
+++ openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 29 May 2003 18:49:17 -0000 1.13
@@ -111,10 +111,7 @@
# Initialize the array to return
array set msg_catalog_array {}
- # An ns_xml bug workaround, may not be necessary still but won't do any harm
- set xml_data [xml_prepare_data $catalog_file_contents]
-
- # Parse the xml document with ns_xml
+ # Parse the xml document
set tree [xml_parse $xml_data]
# Get the message catalog root node
@@ -153,7 +150,7 @@
set value [xml_node_get_attribute $element $attribute]
if { [empty_string_p $value] } {
- error "Required attribute \"$attribute\" missing from <[ns_xml node get name $element]>"
+ error "Required attribute \"$attribute\" missing from <[xml_node_get_name $element]>"
}
return $value
@@ -168,7 +165,7 @@
set content [xml_node_get_content $element]
if { [empty_string_p $content] } {
- error "Required content missing from element <[ns_xml node get name $element]>"
+ error "Required content missing from element <[xml_node_get_name $element]>"
}
return $content
Index: openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl,v
diff -u -N -r1.6 -r1.7
--- openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 28 Mar 2003 15:13:39 -0000 1.6
+++ openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 29 May 2003 18:49:01 -0000 1.7
@@ -1,17 +1,9 @@
-
-# 50-xml-utils-procs.tcl
-# (ben for OpenACS)
-#
# This is a set of utilities for dealing with XML in a nice way,
-# using ns_xml. Since ns_xml only offers a very basic interface to
-# accessing XML documents, we add additional functions. As ns_xml gets
-# better, it's perfectly conceivable that these functions will be
-# implemented more efficiently by calling ns_xml more directly.
+# using tDOM.
#
# It would be nice if this could be used without the ACS, so we're not
# using ad_proc constructs for this at this point.
-
##
## The proc that checks that XML support is complete
##
@@ -20,240 +12,75 @@
set ok_p 1
- if {[llength [info commands ns_xml]] < 1} {
- set xml_status_msg "ns_xml is not installed! You must have ns_xml installed, or nothing will work."
+ if {[llength [info commands tdom]] < 1} {
+ set xml_status_msg "tDOM is not installed! You must have tDOM installed, or nothing will work."
set ok_p 0
- } else {
- if {![_nsxml_comments_ok_p]} {
- append xml_status_msg "Your ns_xml doesn't support XML comments correctly. This issue is currently handled smoothly by some internal work-arounds, but you might want to upgrade ns_xml to the latest version."
- set ok_p 0
- }
+ }
- if {![_nsxml_root_node_ok_p]} {
- append xml_status_msg "Your ns_xml doesn't correctly return the root XML node. This issue is currently handled smoothly by some internal work-arounds, but you might want to upgrade ns_xml to the latest version.
"
- set ok_p 0
- }
-
- if {![_nsxml_version_2_p]} {
- append xml_status_msg "Your ns_xml doesn't support the most recent command syntax. This issue is currently handled smoothly by some internal work-arounds, but you might want to upgrade ns_xml to the latest version.
"
- }
- }
-
return $ok_p
}
-
-# Clean stuff up if we have to
-# I'm unhappy about this, but there seem to be bugs in the XML parser!! (ben)
-proc xml_prepare_data {xml_data} {
- if {[_nsxml_comments_ok_p]} {
- return $xml_data
- } else {
- # remove comments
- regsub -all {} $xml_data "" new_xml_data
- return $new_xml_data
- }
-}
-
-#
-# We need some very simple features here:
-# - parse
-# - get root node
-# - get first real node
-# - get children node
-# - get children node with a particular name
-# - get attribute
-# - get value
-#
-
# Parse a document and return a doc_id
proc xml_parse args {
+# ns_log notice "xml_parse $args"
if {[lindex $args 0] == "-persist"} {
- return [ns_xml parse -persist [lindex $args 1]]
+ return [dom parse -simple [lindex $args 1]]
} else {
- return [ns_xml parse [lindex $args 0]]
+ dom parse -simple [lindex $args 0] doc
+ return $doc
}
}
# Free the doc
proc xml_doc_free {doc_id} {
- ns_xml doc free $doc_id
+# ns_log notice "xml_doc_free $doc_id"
+ $doc_id delete
}
-# Get root node
-proc xml_doc_get_root_node {doc_id} {
- return [ns_xml doc root $doc_id]
-}
-
# Get first node
proc xml_doc_get_first_node {doc_id} {
-
- # get the root from ns_xml
- set root_node [ns_xml doc root $doc_id]
-
- if {[_nsxml_root_node_ok_p]} {
- set first_node [lindex [ns_xml node children $root_node] 0]
- } else {
- set first_node $root_node
- }
-
- return $first_node
+# ns_log notice "xml_doc_get_first_node $doc_id --> [[$doc_id documentElement] nodeName]"
+ return [$doc_id documentElement]
}
-# Get first node with a given name
-proc xml_doc_get_first_node_by_name {doc_id name} {
-
- # get the root from ns_xml
- set root_node [ns_xml doc root $doc_id]
-
- if {[_nsxml_root_node_ok_p]} {
- set first_node [lindex [xml_node_get_children_by_name $root_node $name] 0]
- } else {
- # You'd better hope this is the right node, baby,
- # because ns_xml is broken in this case (ben).
- set first_node $root_node
- }
-
- return $first_node
-}
-
# Get children nodes
proc xml_node_get_children {parent_node} {
- return [ns_xml node children $parent_node]
+ return [$parent_node child all]
}
# Find nodes of a parent that have a given name
proc xml_node_get_children_by_name {parent_node name} {
- set children [xml_node_get_children $parent_node]
+# set msg "xml_node_get_children_by_name [$parent_node nodeName] $name --> "
+# foreach child [$parent_node child all $name] {
+# append msg "[$child nodeName] "
+# }
+# ns_log notice $msg
+ return [$parent_node child all $name]
+}
- set list_of_appropriate_children [list]
-
- foreach child $children {
- if {[ns_xml node name $child] == $name} {
- lappend list_of_appropriate_children $child
- }
- }
-
- return $list_of_appropriate_children
+proc xml_node_get_first_child {parent_node } {
+# ns_log notice "xml_node_get_first_child [$parent_node nodeName] --> [[$parent_node child 1] nodeName]"
+ return [$parent_node child 1]
}
proc xml_node_get_first_child_by_name {parent_node name} {
- set children [xml_node_get_children_by_name $parent_node $name]
- return [lindex $children 0]
+# ns_log notice "xml_node_get_first_child_by_name [$parent_node nodeName] $name --> [[$parent_node child 1 $name] nodeName]"
+ return [$parent_node child 1 $name]
}
# Get Node Name
proc xml_node_get_name {node_id} {
- return [ns_xml node name $node_id]
+ return [$node_id nodeName]
}
# Get Node Attribute
-proc xml_node_get_attribute {node_id attribute_name} {
- if { [_nsxml_version_2_p] } {
- return [ns_xml node get attr $node_id $attribute_name]
- } else {
- return [ns_xml node getattr $node_id $attribute_name]
- }
+proc xml_node_get_attribute {node_id attribute_name {default ""}} {
+# ns_log notice "xml_node_get_attribute [$node_id nodeName] $attribute_name --> [$node_id getAttribute $attribute_name $default]"
+ return [$node_id getAttribute $attribute_name $default]
}
# Get Content
proc xml_node_get_content {node_id} {
- if { [_nsxml_version_2_p] } {
- return [ns_xml node get content $node_id]
- } else {
- return [ns_xml node getcontent $node_id]
- }
+# ns_log notice "xml_node_get_content [$node_id nodeName] --> [$node_id text]"
+ return [$node_id text]
}
-
-##
-## Broken ns_xml
-##
-
-
-# This procedure will test the root node function of ns_xml
-# Since this test will use a sample XML parse to figure out
-# whether or not things work, we want to cache the result so
-# that an additional XML parse isn't performed every time (ben).
-proc _nsxml_root_node_ok_p {} {
-
- # Check cache
- if {[nsv_exists NSXML root_node_ok_p]} {
- return [nsv_get NSXML root_node_ok_p]
- }
-
- # try to parse a sample XML document with a comment
- set sample_xml "text"
- set doc_id [ns_xml parse $sample_xml]
- set root [ns_xml doc root $doc_id]
- set children [ns_xml node children $root]
-
- if {[catch {set name [ns_xml node name [lindex $children 0]]} errmsg]} {
- set result 0
- } else {
- # If the root node is okay, then we're set
- if { $name == "root" } {
- set result 1
- } else {
- set result 0
- }
- }
-
- # store in cache and return
- nsv_set NSXML root_node_ok_p $result
- return $result
-}
-
-# Check if comments are okay
-proc _nsxml_comments_ok_p {} {
-
- # Check cache
- if {[nsv_exists NSXML comments_ok_p]} {
- return [nsv_get NSXML comments_ok_p]
- }
-
- # try to parse a sample XML document with a comment
- set sample_xml "text"
- set doc_id [ns_xml parse $sample_xml]
- set root [ns_xml doc root $doc_id]
- set children [ns_xml node children $root]
-
- if {[catch {set name [ns_xml node name [lindex $children 0]]} errmsg]} {
- set result 0
- } else {
- # If we're talking about a comment node, we're all set
- if { $name == "comment" } {
- set result 1
- } else {
- set result 0
- }
- }
-
- # store in cache and return
- nsv_set NSXML comments_ok_p $result
- return $result
-}
-
-# Check if comments are okay
-proc _nsxml_version_2_p {} {
-
- # Check cache
- if {[nsv_exists NSXML version_2_p]} {
- return [nsv_get NSXML version_2_p]
- }
-
- # try to parse a sample XML document with content
- set sample_xml "text"
- set doc_id [ns_xml parse $sample_xml]
-
- if { [catch {ns_xml node get attr $doc_id root} errmsg] &&
- [string equal $errmsg "unknown command"] } {
- set result 0
- } else {
- set result 1
- }
-
- # store in cache and return
- nsv_set NSXML version_2_p $result
- return $result
-}
-
Index: openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl,v
diff -u -N -r1.20 -r1.21
--- openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl 17 May 2003 10:04:18 -0000 1.20
+++ openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl 29 May 2003 18:49:01 -0000 1.21
@@ -1,10 +1,10 @@
ad_library {
Functions that APM uses to parse and generate XML.
- Changed to use ns_xml by ben (OpenACS).
@author Bryan Quinn (bquinn@arsdigita.com)
@author Ben Adida (ben@mit.edu)
+ @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
@creation-date Fri Oct 6 21:47:39 2000
@cvs-id $Id$
}
@@ -31,13 +31,8 @@
Parses the XML element to return the value for the specified attribute.
} {
- set value [xml_node_get_attribute $element $attribute]
-
- if { [empty_string_p $value] } {
- return $default
- } else {
- return $value
- }
+ ns_log notice "apm_attribute_value $element $attribute $default --> [xml_node_get_attribute $element $attribute $default]"
+ return [xml_node_get_attribute $element $attribute $default]
}
ad_proc -private apm_tag_value {
@@ -48,18 +43,14 @@
} {
Parses the XML element and returns the associated property name if it exists.
} {
- set node [lindex [xml_node_get_children_by_name $root $property_name] 0]
+ ns_log notice "apm_tag_value [$root nodeName] $property_name"
+ set node [xml_node_get_first_child_by_name $root $property_name]
if { ![empty_string_p $node] } {
- set child [lindex [xml_node_get_children $node] 0]
-
- # JCD 20020914 ns_xml when given something like (i.e. empty content)
- # will have the node but the node will not have a child node and the
- # getcontent will then fail.
- if { ![empty_string_p $child] } {
- return [xml_node_get_content $child]
- }
+# ns_log notice "apm_tag_value $root $property_name $default --> [xml_node_get_content $node]"
+ return [xml_node_get_content $node]
}
+ ns_log notice "apm_tag_value $root $property_name $default --> $default"
return $default
}
@@ -237,10 +228,8 @@
set xml_data [read $file]
close $file
- set xml_data [xml_prepare_data $xml_data]
-
- set tree [xml_parse $xml_data]
- set root_node [xml_doc_get_first_node_by_name $tree package]
+ set tree [xml_parse -persist $xml_data]
+ set root_node [xml_doc_get_first_node $tree]
apm_log APMDebug "XML: root node is [xml_node_get_name $root_node]"
set package $root_node
@@ -294,7 +283,7 @@
vendor url
description format
} {
- set node [lindex [xml_node_get_children_by_name $version $property_name] 0]
+ set node [xml_node_get_first_child_by_name $version $property_name]
if { ![empty_string_p $node] } {
set properties($property_name.$attribute_name) [apm_attribute_value $node $attribute_name]
} else {
@@ -364,7 +353,7 @@
foreach node $owners {
set url [apm_attribute_value $node url]
- set name [xml_node_get_content [lindex [xml_node_get_children $node] 0]]
+ set name [xml_node_get_content $node]
lappend properties(owners) [list $name $url]
}
@@ -391,6 +380,9 @@
lappend properties(parameters) [list $name $description $section_name $datatype $min_n_values $max_n_values $default_value]
}
}
+
+ # Release the XML tree
+ xml_doc_free $tree
# Serialize the array into a list.
set return_value [array get properties]