utils.tcl

Linux下的MSN聊天程序源码

# utils.tcl - Copyright (C) 2001 Pat Thoyts <[e-mail]>
#
# DOM data access utilities for use in the TclSOAP package.
#
# -------------------------------------------------------------------------
# This software is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
# for more details.
# -------------------------------------------------------------------------

namespace eval ::SOAP {
    namespace eval Utils {
        variable version 1.0.1
        variable rcsid {$Id: utils.tcl 6394 2006-04-14 17:36:29Z tjikkun $}
        namespace export getElements getElementsByName \
                getElementValue getElementName \
                getElementValues getElementNames \
                getElementNamedValues \
                getElementAttributes getElementAttribute \
                decomposeSoap decomposeXMLRPC selectNode \
                namespaceURI targetNamespaceURI \
                nodeName baseElementName
    }
}

# -------------------------------------------------------------------------

# Description:
#   Provide a version independent selectNode implementation. We either use
#   the version from the dom package or use the SOAP::xpath version if there
#   is no dom one.
# Parameters:
#   node  - reference to a dom tree
#   path  - XPath selection
# Result:
#   Returns the selected node or a list of matching nodes or an empty list
#   if no match.
#
proc ::SOAP::Utils::selectNode {node path} {
    package require SOAP::xpath
    if {[catch {SOAP::xpath::xpath -node $node $path} r]} {
        set r {}
    }
    return $r
}

# -------------------------------------------------------------------------

# for extracting the parameters from a SOAP packet.
# Arrays -> list
# Structs -> list of name/value pairs.
# a methods parameter list comes out looking like a struct where the member
# names == parameter names. This allows us to check the param name if we need
# to.

proc ::SOAP::Utils::is_array {domElement} {
    # Look for "xsi:type"="SOAP-ENC:Array"
    # FIX ME
    # This code should check the namespace using namespaceURI code (CGI)
    #
    set attr [dom::node cget $domElement -attributes]
    upvar #0 attr Attr
    if {[info exists Attr(SOAP-ENC:arrayType)]} {
        return 1
    }
    if {[info exists Attr(xsi:type)]} {
        set type $Attr(xsi:type)
        if {[string match -nocase {*:Array} $type]} {
            return 1
        }
    }

    # If all the child element names are the same, it's an array
    # but of there is only one element???
    set names [getElementNames $domElement]
    if {[llength $names] > 1 && [llength [lsort -unique $names]] == 1} {
        return 1
    }

    return 0
}

# -------------------------------------------------------------------------

# Break down a SOAP packet into a Tcl list of the data.
proc ::SOAP::Utils::decomposeSoap {domElement} {
    set result {}

    # get a list of the child elements of this base element.
    set child_elements [getElements $domElement]

    # if no child element - return the value.
    if {$child_elements == {}} {
	set result [getElementValue $domElement]
    } else {
	# decide if this is an array or struct
	if {[is_array $domElement] == 1} {
	    foreach child $child_elements {
		lappend result [decomposeSoap $child]
	    }
	} else {
	    foreach child $child_elements {
		lappend result [nodeName $child] [decomposeSoap $child]
	    }
	}
    }

    return $result
}

# -------------------------------------------------------------------------

# I expect domElement to be the params element.
proc ::SOAP::Utils::decomposeXMLRPC {domElement} {
    set result {}
    foreach param_elt [getElements $domElement] {
        lappend result [getXMLRPCValue [getElements $param_elt]]
    }
    return $result
}

# -------------------------------------------------------------------------

proc ::SOAP::Utils::getXMLRPCValue {value_elt} {
    set value {}
    if {$value_elt == {}} { return $value }

    # if there is not type element then the specs say it's a string type.
    set type_elt [getElements $value_elt]
    if {$type_elt == {}} {
        return [getElementValue $value_elt]
    }

    set type [getElementName $type_elt]
    if {[string match "struct" $type]} {
        foreach member_elt [getElements $type_elt] {
            foreach elt [getElements $member_elt] {
                set eltname [getElementName $elt]
                if {[string match "name" $eltname]} {
                    set m_name [getElementValue $elt]
                } elseif {[string match "value" $eltname]} {
                    set m_value [getXMLRPCValue $elt]
                }
            }
            lappend value $m_name $m_value
        }
    } elseif {[string match "array" $type]} {
        foreach elt [getElements [lindex [getElements $type_elt] 0]] {
            lappend value [getXMLRPCValue $elt]
        }
    } else {
        set value [getElementValue $type_elt]
    }
    return $value
}

# -------------------------------------------------------------------------

# Description:
#   Return a list of all the immediate children of domNode that are element
#   nodes.
# Parameters:
#   domNode  - a reference to a node in a dom tree
#
proc ::SOAP::Utils::getElements {domNode} {
    set elements {}
    if {$domNode != {}} {
        foreach node [dom::node children $domNode] {
            if {[dom::node cget $node -nodeType] == "element"} {
                lappend elements $node
            }
        }
    }
    return $elements
}

# -------------------------------------------------------------------------

# Description:
#   If there are child elements then recursively call this procedure on each
#   child element. If this is a leaf element, then get the element value data.
# Parameters:
#   domElement - a reference to a dom element node
# Result:
#   Returns a value or a list of values.
#
proc ::SOAP::Utils::getElementValues {domElement} {
    set result {}
    if {$domElement != {}} {
        set nodes [getElements $domElement]
        if {$nodes =={}} {
            set result [getElementValue $domElement]
        } else {
            foreach node $nodes {
                lappend result [getElementValues $node]
            }
        }
    }
    return $result
}

# -------------------------------------------------------------------------

proc ::SOAP::Utils::getElementValuesList {domElement} {
    set result {}
    if {$domElement != {}} {
        set nodes [getElements $domElement]
        if {$nodes =={}} {
            set result [getElementValue $domElement]
        } else {
            foreach node $nodes {
                lappend result [getElementValues $node]
            }
        }
    }
    return $result
}

# -------------------------------------------------------------------------

proc ::SOAP::Utils::getElementNames {domElement} {
    set result {}
    if {$domElement != {}} {
        set nodes [getElements $domElement]
        if {$nodes == {}} {
            set result [getElementName $domElement]
        } else {
            foreach node $nodes {
                lappend result [getElementName $node]
            }
        }
    }
    return $result
}

# -------------------------------------------------------------------------

proc ::SOAP::Utils::getElementNamedValues {domElement} {
    set name [getElementName $domElement]
    set value {}
    set nodes [getElements $domElement]
    if {$nodes == {}} {
	set value [getElementValue $domElement]
    } else {
	foreach node $nodes {
	    lappend value [getElementNamedValues $node]
	}
    }
    return [list $name $value]
}

# -------------------------------------------------------------------------

# Description: