Index: Utilities.tcl ================================================================== --- Utilities.tcl +++ Utilities.tcl @@ -68,11 +68,11 @@ } package require tdom 0.8 package require struct::set -package provide WS::Utils 2.6.1 +package provide WS::Utils 2.6.2 namespace eval ::WS {} namespace eval ::WS::Utils { set ::WS::Utils::typeInfo {} @@ -3390,11 +3390,11 @@ set partType $tns:$partType } ## ## Convert the reference to the local tns space ## - set partType [getQualifiedType $results $partType $tns] + set partType [getQualifiedType $results $partType $tns $middleNode] set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType] set refTypeInfo [dict get $refTypeInfo definition] set tmpList [dict keys $refTypeInfo] if {[llength $tmpList] == 1} { ## @@ -3404,11 +3404,11 @@ ## ## To at type, so redefine the name ## set partName [lindex [dict keys $refTypeInfo] 0] } - set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns] + set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns $middleNode] } lappend partList $partName [list type $partType] }]} { lappend unknownRef($partType) $typeName return \ @@ -3416,11 +3416,12 @@ -errorcode [list WS $mode UNKREF [list $typeName $partType]] \ "Unknown forward type reference {$partType} in {$typeName}" } } else { set partName [$middleNode getAttribute name] - set partType [string trimright [getQualifiedType $results [$middleNode getAttribute type string:string] $tns] {?}] + set partType [string trimright \ + [getQualifiedType $results [$middleNode getAttribute type string:string] $tns $middleNode] {?}] set partMax [$middleNode getAttribute maxOccurs 1] if {$partMax <= 1} { lappend partList $partName [list type $partType comment $comment] } else { lappend partList $partName [list type [string trimright ${partType} {()}]() comment $comment] @@ -3643,21 +3644,21 @@ ## } element { catch { set partName [$node getAttribute name] - set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns] {?}] + set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns $node] {?}] set partMax [$node getAttribute maxOccurs 1] if {$partMax <= 1} { set partList [list $partName [list type $partType comment {}]] } else { set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]] } } } extension { - set baseName [getQualifiedType $results [$node getAttribute base string] $tns] + set baseName [getQualifiedType $results [$node getAttribute base string] $tns $node] set baseTypeInfo [TypeInfo Client $serviceName $baseName] ::log::logsubst debug {\t base name of extension is {$baseName} with typeinfo {$baseTypeInfo}} if {[lindex $baseTypeInfo 0]} { if {[catch {::WS::Utils::GetServiceTypeDef Client $serviceName $baseName}]} { set baseQuery [format {child::*[attribute::name='%s']} $baseName] @@ -3751,14 +3752,14 @@ if {[info exists simpleTypes($mode,$serviceName,$tns:$partName)]} { set additional_defininition_elements $simpleTypes($mode,$serviceName,$tns:$partName) set partType [dict get $additional_defininition_elements baseType] } } else { - set partType [getQualifiedType $results [$element getAttribute type string] $tns] + set partType [getQualifiedType $results [$element getAttribute type string] $tns $element] } } else { - set partType [getQualifiedType $results [$element getAttribute type string] $tns] + set partType [getQualifiedType $results [$element getAttribute type string] $tns $element] } } if {[string length $occurs]} { set partMax [$element getAttribute maxOccurs 1] if {$partMax < $occurs} { @@ -3900,11 +3901,11 @@ ::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving} return } set typeType "" if {[$node hasAttribute type]} { - set typeType [getQualifiedType $results [$node getAttribute type string] $tns] + set typeType [getQualifiedType $results [$node getAttribute type string] $tns $node] } ::log::logsubst debug {Elemental Type is $typeName} set partList {} set partType {} set isAbstractType false @@ -3976,16 +3977,16 @@ if {[llength $childList]} { ## ## Element defines another element layer ## set partName [$element getAttribute name] - set partType [getQualifiedType $results $partName $tns] + set partType [getQualifiedType $results $partName $tns $element] parseElementalType $mode results $serviceName $element $tns } else { set partName [$element getAttribute name] if {[$element hasAttribute type]} { - set partType [getQualifiedType $results [$element getAttribute type] $tns] + set partType [getQualifiedType $results [$element getAttribute type] $tns $element] } else { set partType xs:string } } @@ -4032,13 +4033,13 @@ } } } # have an element with a type only, so do the work here if {[$node hasAttribute type]} { - set partType [getQualifiedType $results [$node getAttribute type] $tns] + set partType [getQualifiedType $results [$node getAttribute type] $tns $node] } elseif {[$node hasAttribute base]} { - set partType [getQualifiedType $results [$node getAttribute base] $tns] + set partType [getQualifiedType $results [$node getAttribute base] $tns $node] } else { set partType xs:string } set partMax [$node getAttribute maxOccurs 1] if {$partMax <= 1} { @@ -4527,16 +4528,19 @@ # #>>BEGIN PRIVATE<< # # Procedure Name : ::WS::Utils::getQualifiedType # -# Description : Set attributes on a DOM node +# Description : Get a qualified type name from a local reference. +# Thus return : which is in the global type list. +# The is adjusted to point to the global type list. # # Arguments : # serviceInfo - service information dictionary # type - type to get local qualified type on # tns - current namespace +# node - optional XML item to search for xmlns:* attribute # # Returns : nothing # # Side-Effects : None # @@ -4553,30 +4557,70 @@ # adding a complete entry at the bottom of the list. # # Version Date Programmer Comments / Changes / Reasons # ------- ---------- ---------- ------------------------------------------- # 1 02/24/2011 G. Lester Initial version +# 2.6.2 2018-09-22 C. Werner Added parameter "node" to first search a +# namespace attribute "xmlns:yprefix>" in the +# current node. # ########################################################################### -proc ::WS::Utils::getQualifiedType {serviceInfo type tns} { +proc ::WS::Utils::getQualifiedType {serviceInfo type tns {node {}}} { set typePartsList [split $type {:}] if {[llength $typePartsList] == 1} { + # No namespace prefix given - use current prefix set result $tns:$type } else { lassign $typePartsList tmpTns tmpType + # Search the namespace attribute in the current node for a node-local prefix. + # Aim is to translate the node-local prefix to a global namespace prefix. + # Example: + # + # + # Variable setup: + # - type: x1:ArrayOfSomething + # - tmpTns: x1 + # - tmpType: ArrayOfSomething + # Return value: + # - + # - plus ":ArrayOfSomething" + if {$node ne {}} { + set attr xmlns:$tmpTns + if {[$node hasAttribute $attr]} { + # There is a node-local attribute (Example: xmlns:x1) giving the node namespace + set xmlns [$node getAttribute $attr] + if {[dict exists $serviceInfo tnsList url $xmlns]} { + set result [dict get $serviceInfo tnsList url $xmlns]:$tmpType + ::log::logsubst debug {Got global qualified type '$result' from node-local qualified namespace '$xmlns'} + return $result + } else { + # The node namespace (Ex: http://foo.org/bar) was not found as global prefix. + # Thus, the type is refused. + # HaO 2018-11-05 Opinion: + # Continuing here is IMHO not an option, as the prefix (Ex: x1) might have a + # different namespace on the global level which would lead to a misassignment. + # + # One day, we may support cascading namespace prefixes. Then, we may define + # the namespace here + set errMsg "Node local namespace URI '$xmlns' not found for type: '$type'" + ::log::log error $errMsg + return -code error $errMsg + } + } + } if {[dict exists $serviceInfo tnsList tns $tmpTns]} { set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType } elseif {[dict exists $serviceInfo types $type]} { set result $type } else { ::log::log error $serviceInfo ::log::logsubst error {Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}} - set result $tns:$type - return -code error + return -code error "Namespace prefix of type '$Type' not found." } - } return $result } ########################################################################### Index: pkgIndex.tcl ================================================================== --- pkgIndex.tcl +++ pkgIndex.tcl @@ -12,8 +12,8 @@ package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] package ifneeded WS::Client 2.6.0 [list source [file join $dir ClientSide.tcl]] package ifneeded WS::Embeded 2.6.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::Embedded 2.6.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::Server 2.6.0 [list source [file join $dir ServerSide.tcl]] -package ifneeded WS::Utils 2.6.1 [list source [file join $dir Utilities.tcl]] +package ifneeded WS::Utils 2.6.2 [list source [file join $dir Utilities.tcl]] package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]] package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]