1# xpath.tcl - Copyright (C) 2001 Pat Thoyts <patthoyts@users.sourceforge.net> 2# 3# Provide a _SIGNIFICANTLY_ simplified version of XPath querying for DOM 4# document objects. This might get expanded to eventually conform to the 5# W3Cs XPath specification but at present this is purely for use in querying 6# DOM documents for specific elements by the SOAP package. 7# 8# Subject to interface changes 9# 10# ------------------------------------------------------------------------- 11# This software is distributed in the hope that it will be useful, but 12# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 13# or FITNESS FOR A PARTICULAR PURPOSE. See the accompanying file `LICENSE' 14# for more details. 15# ------------------------------------------------------------------------- 16 17if { [catch {package require dom 2.0}] } { 18 if { [catch {package require dom 1.6}] } { 19 error "require dom package greater than 1.6" 20 } 21} 22 23namespace eval SOAP::xpath { 24 variable version 0.2 25 variable rcsid { $Id: xpath.tcl,v 1.9 2003/09/06 17:08:46 patthoyts Exp $ } 26 namespace export xpath xmlnsSplit 27} 28 29# ------------------------------------------------------------------------- 30 31# Given Envelope/Body/Fault and a DOM node, see if we can find a matching 32# element else return {} 33 34# TODO: Paths including attribute selection etc. 35 36proc ::SOAP::xpath::xpath { args } { 37 if { [llength $args] < 2 || [llength $args] > 3 } { 38 return -code error "wrong # args:\ 39 should be \"xpath ?option? rootNode path\"" 40 } 41 42 array set opts { 43 -node 0 44 -name 0 45 -attributes 0 46 } 47 48 if { [llength $args] == 3 } { 49 set opt [lindex $args 0] 50 switch -glob -- $opt { 51 -nod* { set opts(-node) 1 } 52 -nam* { set opts(-name) 1 } 53 -att* { set opts(-attributes) 1 } 54 default { 55 return -code error "bad option \"$opt\":\ 56 must be [array names opts]" 57 } 58 } 59 set args [lrange $args 1 end] 60 } 61 62 set root [lindex $args 0] 63 set path [lindex $args 1] 64 65 # split the path up and call find_node to get the new node or nodes. 66 set root [find_node $root [split [string trimleft $path {/}] {/}]] 67 68 # return the elements value (if any) 69 if { $opts(-node) } { 70 return $root 71 } 72 73 set value {} 74 if { $opts(-attributes) } { 75 foreach node $root { 76 append value [array get [dom::node cget $node -attributes]] 77 } 78 return $value 79 } 80 81 if { $opts(-name) } { 82 foreach node $root { 83 lappend value [dom::node cget $node -nodeName] 84 } 85 return $value 86 } 87 88 foreach node $root { 89 set children [dom::node children $node] 90 set v "" 91 foreach child $children { 92 append v [string trim [dom::node cget $child -nodeValue] "\n"] 93 } 94 lappend value $v 95 } 96 return $value 97} 98 99# ------------------------------------------------------------------------- 100 101# check for an element (called $target) that is a child of root. Returns 102# the node(s) or {} 103proc ::SOAP::xpath::find_node { root pathlist } { 104 set r {} 105 set kids "" 106 107 if { $pathlist == {} } { 108 return {} 109 } 110 111 #set target [split $path {/}] 112 set remainder [lrange $pathlist 1 end] 113 set target [lindex $pathlist 0] 114 115 # split the target into XML namespace and element names. 116 set targetName [xmlnsSplit $target] 117 set targetNamespace [lindex $targetName 0] 118 set targetName [lindex $targetName 1] 119 120 # get information about the child elements. 121 foreach element $root { 122 append kids [child_elements $element] 123 } 124 125 # match name and (optionally) namespace 126 foreach {node ns elt} $kids { 127 if { [string match $targetName $elt] } { 128 #puts "$node nodens=$ns elt=$elt targetNS=$targetNamespace\ 129 #targetName=$targetName" 130 if { $targetNamespace == {} || [string match $targetNamespace $ns] } { 131 if {$remainder != ""} { 132 set rr [find_node $node $remainder] 133 } else { 134 set rr $node 135 } 136 set r [concat $r $rr] 137 #puts "$kids : $targetName : $remainder -> $r" 138 } 139 } 140 } 141 142 # Flatten the list out. 143 return [eval "list $r"] 144} 145 146# ------------------------------------------------------------------------- 147 148# Return list of {node namespace elementname} for each child element of root 149proc ::SOAP::xpath::child_elements { root } { 150 set kids {} 151 set children [dom::node children $root] 152 foreach node $children { 153 set type [string trim [dom::node cget $node -nodeType ]] 154 if { $type == "element" } { 155 catch {unset xmlns} 156 array set xmlns [xmlnsConstruct $node] 157 158 #set name [xmlnsQualify xmlns [dom::node cget $node -nodeName]] 159 set name [dom::node cget $node -nodeName] 160 set name [xmlnsSplit $name] 161 lappend kids $node [lindex $name 0] [lindex $name 1] 162 } 163 } 164 return $kids 165} 166 167# ------------------------------------------------------------------------- 168 169# Description: 170# Split a DOM element tag into the namespace and tag components. This 171# will even work for fully qualified namespace names eg: 172# Body -> {} Body 173# SOAP-ENV:Body -> SOAP-ENV Body 174# urn:test:Body -> urn:test Body 175# http://localhost:80/:Body -> http://localhost:80/ Body 176# 177proc ::SOAP::xpath::xmlnsSplit {elementName} { 178 set name [split $elementName :] 179 set len [llength $name] 180 if { $len == 1 } { 181 set ns {} 182 } else { 183 incr len -2 184 set ns [join [lrange $name 0 $len] :] 185 set name [lindex $name end] 186 } 187 return [list $ns $name] 188} 189 190# ------------------------------------------------------------------------- 191 192# Build a list of any XML namespace definitions for node 193# Returns a list of {namesnameName qualifiedName} 194# 195proc ::SOAP::xpath::xmlnsGet {node} { 196 set result {} 197 foreach {ns fqns} [array get [dom::node cget $node -attributes]] { 198 set ns [split $ns :] 199 if { [lindex $ns 0] == "xmlns" } { 200 lappend result [lindex $ns 1] $fqns 201 } 202 } 203 return $result 204} 205 206# ------------------------------------------------------------------------- 207 208# Build a list of {{xml namespace name} {qualified namespace}} working up the 209# DOM tree from node. You should look for the last occurrence of your name 210# in the list. 211proc ::SOAP::xpath::xmlnsConstruct {node} { 212 set result [xmlnsGet $node] 213 set parent [dom::node parent $node] 214 while { [dom::node cget $parent -nodeType] == "element" } { 215 set result [concat [xmlnsGet $parent] $result] 216 set parent [dom::node parent $parent] 217 } 218 return $result 219} 220 221# ------------------------------------------------------------------------- 222 223# Split an XML element name into its namespace and name parts and return 224# a fully qualified XML element name. 225# xmlnsNamespaces should be an array of namespaceNames to qualified names 226# constructed using array set var [xmlnsConstruct $node] 227# 228proc ::SOAP::xpath::xmlnsQualify {xmlnsNamespaces elementName} { 229 upvar $xmlnsNamespaces xmlns 230 set name [split $elementName :] 231 if { [llength $name] == 1} { 232 return $elementName 233 } 234 if { [llength $name] != 2 } { 235 return -code error "wrong # elements:\ 236 name should be namespaceName:elementName" 237 } 238 if { [catch {set fqns $xmlns([lindex $name 0])}] } { 239 return -code error "invalid namespace name:\ 240 \"[lindex $name 0]\" not found" 241 } 242 243 return "${fqns}:[lindex $name 1]" 244} 245 246# ------------------------------------------------------------------------- 247 248package provide SOAP::xpath $::SOAP::xpath::version 249 250# ------------------------------------------------------------------------- 251# Local variables: 252# indent-tabs-mode: nil 253# End: 254