$xml_status_msg" + set error_p 1 +} + # OpenNSD must support the "fancy" ADP parser. set adp_support [ns_config "ns/server/[ns_info server]/adp" DefaultParser] if { [string compare $adp_support "fancy"] } { 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.18 -r1.19 --- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 30 May 2001 20:53:00 -0000 1.18 +++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 14 Jul 2001 23:03:25 -0000 1.19 @@ -5,8 +5,8 @@ # # Ben Adida (ben@mit.edu) # -# STATE OF THIS FILE (4/20/2001) - ben: -# This is working well with relative and absolute path names +# 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/ @@ -536,31 +536,34 @@ proc db_qd_internal_parse_init {stuff_to_parse file_path} { # Do initial parse - set parsed_doc [ns_xml parse -persist $stuff_to_parse] + set parsed_doc [xml_parse -persist $stuff_to_parse] # Initialize the parsing state set index 0 # Get the list of queries out - set root_node [ns_xml doc root $parsed_doc] + set root_node [xml_doc_get_first_node $parsed_doc] # Check that it's a queryset - if {[ns_xml node name $root_node] != "queryset"} { + if {[xml_node_get_name $root_node] != "queryset"} { + db_qd_log Notice "OH OH, error, first node is [xml_node_get_name $root_node]" # CHANGE THIS: throw an error!!! return "" } # Extract the default RDBMS if there is one - set rdbms_nodes [xml_find_child_nodes $root_node rdbms] + set rdbms_nodes [xml_node_get_children_by_name $root_node rdbms] if {[llength $rdbms_nodes] > 0} { set default_rdbms [db_rdbms_parse_from_xml_node [lindex $rdbms_nodes 0]] db_qd_log Notice "Detected DEFAULT RDBMS for whole queryset: $default_rdbms" } else { set default_rdbms "" } - set parsed_stuff [xml_find_child_nodes $root_node fullquery] + set parsed_stuff [xml_node_get_children_by_name $root_node fullquery] + db_qd_log Notice "end of parse_init: $index; $parsed_stuff; $parsed_doc; $default_rdbms; $file_path" + return [list $index $parsed_stuff $parsed_doc $default_rdbms $file_path] } @@ -587,7 +590,7 @@ # BASE CASE if {[llength $node_list] <= $index} { # Clean up - ns_xml doc free $parsed_doc + xml_doc_free $parsed_doc db_qd_log Notice "Cleaning up, done parsing" @@ -616,20 +619,20 @@ # Parse one query from an XML node proc db_qd_internal_parse_one_query_from_xml_node {one_query_node {default_rdbms {}} {file_path {}}} { - db_qd_log Notice "parsing one query node in XML with name -[ns_xml node name $one_query_node]-" + db_qd_log Notice "parsing one query node in XML with name -[xml_node_get_name $one_query_node]-" # Check that this is a fullquery - if {[ns_xml node name $one_query_node] != "fullquery"} { + if {[xml_node_get_name $one_query_node] != "fullquery"} { return "" } - set queryname [ns_xml node getattr $one_query_node name] + set queryname [xml_node_get_attribute $one_query_node name] # Get the text of the query - set querytext [ns_xml node getcontent [lindex [xml_find_child_nodes $one_query_node querytext] 0]] + set querytext [xml_node_get_content [xml_node_get_first_child_by_name $one_query_node querytext]] # Get the RDBMS - set rdbms_nodes [xml_find_child_nodes $one_query_node rdbms] + set rdbms_nodes [xml_node_get_children_by_name $one_query_node rdbms] # If we have no RDBMS specified, use the default if {[llength $rdbms_nodes] == 0} { @@ -646,14 +649,14 @@ # Parse and RDBMS struct from an XML fragment node proc db_rdbms_parse_from_xml_node {rdbms_node} { # Check that it's RDBMS - if {[ns_xml node name $rdbms_node] != "rdbms"} { + if {[xml_node_get_name $rdbms_node] != "rdbms"} { db_qd_log Notice "PARSER = BAD RDBMS NODE!" return "" } # Get the type and version tags - set type [ns_xml node getcontent [lindex [xml_find_child_nodes $rdbms_node type] 0]] - set version [ns_xml node getcontent [lindex [xml_find_child_nodes $rdbms_node version] 0]] + set type [xml_node_get_content [xml_node_get_first_child_by_name $rdbms_node type]] + set version [xml_node_get_content [xml_node_get_first_child_by_name $rdbms_node version]] db_qd_log Notice "PARSER = RDBMS parser - $type - $version" @@ -751,5 +754,6 @@ proc db_qd_log {level msg} { # Centralized DB QD logging # We switch everything to debug for now - ns_log Debug "QD_LOGGER = $msg" -} \ No newline at end of file + ns_log Notice "QD_LOGGER = $msg" +} + 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.2 -r1.3 --- openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 31 May 2001 21:18:07 -0000 1.2 +++ openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 14 Jul 2001 23:03:25 -0000 1.3 @@ -11,17 +11,116 @@ # 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 +## +proc xml_support_ok {varname} { + upvar $varname xml_status_msg + + 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." + 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 ASAP.
" + 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 ASAP.
"
+ set ok_p 0
+ }
+ }
+
+ 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} {
- # remove comments
- regsub -all {} $xml_data "" new_xml_data
- return $new_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 {
+ if {[lindex $args 0] == "-persist"} {
+ return [ns_xml parse -persist [lindex $args 1]]
+ } else {
+ return [ns_xml parse [lindex $args 0]]
+ }
+}
+
+# Free the doc
+proc xml_doc_free {doc_id} {
+ ns_xml doc free $doc_id
+}
+
+# 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
+}
+
+# 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]
+}
+
# Find nodes of a parent that have a given name
-proc xml_find_child_nodes {parent_node name} {
- set children [ns_xml node children $parent_node]
+proc xml_node_get_children_by_name {parent_node name} {
+ set children [xml_node_get_children $parent_node]
set list_of_appropriate_children [list]
@@ -34,3 +133,91 @@
return $list_of_appropriate_children
}
+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]
+}
+
+# Get Node Name
+proc xml_node_get_name {node_id} {
+ return [ns_xml node name $node_id]
+}
+
+# Get Node Attribute
+proc xml_node_get_attribute {node_id attribute_name} {
+ return [ns_xml node getattr $node_id $attribute_name]
+}
+
+# Get Content
+proc xml_node_get_content {node_id} {
+ return [ns_xml node getcontent $node_id]
+}
+
+##
+## 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 "