Changes On Branch ticket-6fbee320-local-ns-prefix
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch ticket-6fbee320-local-ns-prefix Excluding Merge-Ins

This is equivalent to a diff from 07f65e990e to 12bb39fa7a

2018-12-06 12:17
(WSDL)Support type with namespace definition in tag. Ticket [6fbee3208e] check-in: a1cf727fd3 user: oehhar tags: trunk
2018-11-05 13:41
Fail in case of a node local namespace, which is not found globally. Before, an identical global prefix (with other namespace) may be picked. Closed-Leaf check-in: 12bb39fa7a user: oehhar tags: ticket-6fbee320-local-ns-prefix
2018-11-05 08:48
Patch to support ns prefix defined in the element. Ticket [6fbee3208e] check-in: 62c4dae5f1 user: oehhar tags: ticket-6fbee320-local-ns-prefix
2018-09-03 17:55
Replaced stderr error print by error log (::WS::Utils::ProcessImportXml). Plus some documentation and ticket numbers. check-in: 07f65e990e user: oehhar tags: trunk
2018-09-03 17:26
Changed WS:Utils package version to 2.6.1 check-in: 2a9f30c6aa user: oehhar tags: trunk

Changes to Utilities.tcl.

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
        ::log::log $level [uplevel 1 [list subst $text]]
    }
}

package require tdom 0.8
package require struct::set

package provide WS::Utils 2.6.1

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}







|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
        ::log::log $level [uplevel 1 [list subst $text]]
    }
}

package require tdom 0.8
package require struct::set

package provide WS::Utils 2.6.2

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420

3421
3422
3423
3424
3425
3426
3427
3428
                        set refNS [lindex $refTypeInfo 0]
                        if {[string equal $refNS {}]} {
                            set partType $tns:$partType
                        }
                        ##
                        ## Convert the reference to the local tns space
                        ##
                        set partType  [getQualifiedType $results $partType $tns]
                        set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                        set refTypeInfo [dict get $refTypeInfo definition]
                        set tmpList [dict keys $refTypeInfo]
                        if {[llength $tmpList] == 1} {
                            ##
                            ## See if the reference is to an element or a type
                            ##
                            if {![dict exists $results elements $partType]} {
                                ##
                                ## To at type, so redefine the name
                                ##
                                set partName [lindex [dict keys $refTypeInfo] 0]
                            }
                            set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns]
                        }
                        lappend partList $partName [list type $partType]
                    }]} {
                        lappend unknownRef($partType) $typeName
                        return \
                            -code error \
                            -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 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]
                    }
                }







|













|











>
|







3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
                        set refNS [lindex $refTypeInfo 0]
                        if {[string equal $refNS {}]} {
                            set partType $tns:$partType
                        }
                        ##
                        ## Convert the reference to the local tns space
                        ##
                        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} {
                            ##
                            ## See if the reference is to an element or a type
                            ##
                            if {![dict exists $results elements $partType]} {
                                ##
                                ## To at type, so redefine the name
                                ##
                                set partName [lindex [dict keys $refTypeInfo] 0]
                            }
                            set partType [getQualifiedType $results [dict get $refTypeInfo $partName type] $tns $middleNode]
                        }
                        lappend partList $partName [list type $partType]
                    }]} {
                        lappend unknownRef($partType) $typeName
                        return \
                            -code error \
                            -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 $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]
                    }
                }
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
                set partName [$node getAttribute name]
                set partType [string trimright [getQualifiedType $results [$node getAttribute type string] $tns] {?}]
                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 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]
                    set baseNode [$currentSchema selectNodes $baseQuery]
                    #puts "$baseQuery gave {$baseNode}"







|









|







3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
            ##
            ## Do Nothing
            ##
        }
        element {
            catch {
                set partName [$node getAttribute name]
                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 $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]
                    set baseNode [$currentSchema selectNodes $baseQuery]
                    #puts "$baseQuery gave {$baseNode}"
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
                                set partType $partName
                                parseComplexType $mode results $serviceName $element $tns
                                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]
                            }
                        } else {
                            set partType [getQualifiedType $results [$element getAttribute type string] $tns]
                        }
                    }
                    if {[string length $occurs]} {
                        set partMax [$element getAttribute maxOccurs 1]
                        if {$partMax < $occurs} {
                            set partMax $occurs
                        }







|


|







3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
                                set partType $partName
                                parseComplexType $mode results $serviceName $element $tns
                                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 $element]
                            }
                        } else {
                            set partType [getQualifiedType $results [$element getAttribute type string] $tns $element]
                        }
                    }
                    if {[string length $occurs]} {
                        set partMax [$element getAttribute maxOccurs 1]
                        if {$partMax < $occurs} {
                            set partMax $occurs
                        }
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
    set typeName [$node getAttribute $attributeName]
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::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]
    }
    ::log::logsubst debug {Elemental Type is $typeName}
    set partList {}
    set partType {}
    set isAbstractType false
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]







|







3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
    set typeName [$node getAttribute $attributeName]
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::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 $node]
    }
    ::log::logsubst debug {Elemental Type is $typeName}
    set partList {}
    set partType {}
    set isAbstractType false
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
            ::log::logsubst debug {\t\t\ has no ref has [llength $childList]}
            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                set partType [getQualifiedType $results $partName $tns]
                parseElementalType $mode results $serviceName $element $tns
            } else {
                set partName [$element getAttribute name]
                if {[$element hasAttribute type]} {
                    set partType [getQualifiedType $results [$element getAttribute type] $tns]
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]







|




|







3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
            ::log::logsubst debug {\t\t\ has no ref has [llength $childList]}
            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                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 $element]
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
                    ## Placed here to shut up tclchecker
                    ##
                }
            }
        }
        # have an element with a type only, so do the work here
        if {[$node hasAttribute type]} {
            set partType [getQualifiedType $results [$node getAttribute type] $tns]
        } elseif {[$node hasAttribute base]}  {
            set partType [getQualifiedType $results [$node getAttribute base] $tns]
        } else {
            set partType xs:string
        }
        set partMax [$node getAttribute maxOccurs 1]
        if {$partMax <= 1} {
            ##
            ## See if this is just a restriction on a simple type







|

|







4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
                    ## Placed here to shut up tclchecker
                    ##
                }
            }
        }
        # have an element with a type only, so do the work here
        if {[$node hasAttribute type]} {
            set partType [getQualifiedType $results [$node getAttribute type] $tns $node]
        } elseif {[$node hasAttribute base]}  {
            set partType [getQualifiedType $results [$node getAttribute base] $tns $node]
        } else {
            set partType xs:string
        }
        set partMax [$node getAttribute maxOccurs 1]
        if {$partMax <= 1} {
            ##
            ## See if this is just a restriction on a simple type
4525
4526
4527
4528
4529
4530
4531
4532


4533
4534
4535
4536
4537

4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557



4558
4559
4560
4561
4562
4563

4564
4565
4566






































4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
# Private Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Utils::getQualifiedType
#
# Description : Set attributes on a DOM node


#
# Arguments :
#       serviceInfo - service information dictionary
#       type        - type to get local qualified type on
#       tns         - current namespace

#
# Returns :     nothing
#
# Side-Effects :        None
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald Lester
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  02/24/2011  G. Lester    Initial version



#
###########################################################################
proc ::WS::Utils::getQualifiedType {serviceInfo type tns} {

    set typePartsList [split $type {:}]
    if {[llength $typePartsList] == 1} {

        set result $tns:$type
    } else {
        lassign $typePartsList tmpTns tmpType






































        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 $result
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure







|
>
>





>




















>
>
>


|



>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







<
|

<







4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619

4620
4621

4622
4623
4624
4625
4626
4627
4628
# Private Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Utils::getQualifiedType
#
# Description : Get a qualified type name from a local reference.
#               Thus return <Prefix>:<Type> which is in the global type list.
#               The <Prefix> 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
#
# Exception Conditions :        None
#
# Pre-requisite Conditions :    None
#
# Original Author : Gerald Lester
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       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 {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:
        # <xs:element name="A_O_S"
        #    type="x1:ArrayOfSomething"
        #    xmlns:x1="http://foo.org/bar" />
        #
        # Variable setup:
        # - type: x1:ArrayOfSomething
        # - tmpTns: x1
        # - tmpType: ArrayOfSomething
        # Return value:
        #   - <Prefix in serviceinfo which corresponds to namespace: "http://foo.org/bar">
        #   - 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}}

            return -code error "Namespace prefix of type '$Type' not found."
        }

    }
    return $result
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure

Changes to pkgIndex.tcl.

10
11
12
13
14
15
16
17
18
19

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
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::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]







|


10
11
12
13
14
15
16
17
18
19

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
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.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]]