Check-in [7ae81cabfb]
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Fixed bug to get qualified namespace.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7ae81cabfbd94313a2ecd5c313da860de5e596af
User & Date: gerald 2013-04-19 21:44:54
Context
2013-04-20 03:49
Fix a interaction bug with skipLevelWhenActionPresent and nsOnChangeOnly. check-in: 496530e891 user: gerald tags: trunk, Release_2.3.3
2013-04-19 21:44
Fixed bug to get qualified namespace. check-in: 7ae81cabfb user: gerald tags: trunk
2013-04-10 03:10
Added documentation on how type casting of abstract to concrete types works. check-in: bc60d4585a user: gerald tags: trunk, Release_2.3.2
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl. 

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

package require uri

catch {
    package require tls
    http::register https 443 ::tls::socket
}

package provide WS::Client 2.3.2

namespace eval ::WS::Client {
    ##
    ## serviceArr is indexed by service name and contains a dictionary that
    ## defines the service.  The dictionary has the following structure:
    ##   targetNamespace - the target namespace
    ##   operList - list of operations







|








47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

package require uri

catch {
    package require tls
    http::register https 443 ::tls::socket
}

package provide WS::Client 2.3.3

namespace eval ::WS::Client {
    ##
    ## serviceArr is indexed by service name and contains a dictionary that
    ## defines the service.  The dictionary has the following structure:
    ##   targetNamespace - the target namespace
    ##   operList - list of operations

Changes to ServerSide.tcl. 

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

package require Tcl 8.4
package require WS::Utils 2.3.2 ; # provides dict
package require html
package require log
package require tdom

package provide WS::Server 2.3.2

namespace eval ::WS::Server {
    array set ::WS::Server::serviceArr {}
    set ::WS::Server::procInfo {}
    set ::WS::Server::mode {}
}








|








40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

package require Tcl 8.4
package require WS::Utils 2.3.2 ; # provides dict
package require html
package require log
package require tdom

package provide WS::Server 2.3.3

namespace eval ::WS::Server {
    array set ::WS::Server::serviceArr {}
    set ::WS::Server::procInfo {}
    set ::WS::Server::mode {}
}

Changes to Utilities.tcl. 

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
....
2421
2422
2423
2424
2425
2426
2427

2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
....
4026
4027
4028
4029
4030
4031
4032

4033
4034
4035
4036
4037
4038
4039


4040

4041
4042
4043
4044
4045
4046
4047

    }
}

package require log
package require tdom 0.8
package require struct::set

package provide WS::Utils 2.3.2

namespace eval ::WS {}

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

    set currentSchema $schemaNode
    if {[$schemaNode hasAttribute targetNamespace]} {
        set xns [$schemaNode getAttribute targetNamespace]
    } else {
        set xns $baseUrl
    }

    if {![dict exists $serviceInfo tnsList url $xns]} {
        set tns [format {tns%d} [incr tnsCount]]
        dict set serviceInfo targetNamespace $tns $xns
        dict set serviceInfo tnsList url $xns $tns
        dict set serviceInfo tnsList tns $tns $tns
    } else {
        set tns [dict get $serviceInfo tnsList url $xns]
    }
    ::log::log debug "@3 TNS count for $baseUrl is $tnsCount {$tns}"

    set prevTnsDict [dict get $serviceInfo tnsList tns]
    dict set serviceInfo tns {}
    foreach itemList [$schemaNode attributes xmlns:*] {
        set ns [lindex $itemList 0]
        set url [$schemaNode getAttribute xmlns:$ns]
        if {[dict exists $serviceInfo tnsList url $url]} {
................................................................................
#
# 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


        } else {

            ::log::log error "Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}"
            set result $tns:$type
            return -code error
        }

    }
    return $result







|







 







>








|







 







>







>
>

>








55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
....
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
....
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052

    }
}

package require log
package require tdom 0.8
package require struct::set

package provide WS::Utils 2.3.3

namespace eval ::WS {}

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

    set currentSchema $schemaNode
    if {[$schemaNode hasAttribute targetNamespace]} {
        set xns [$schemaNode getAttribute targetNamespace]
    } else {
        set xns $baseUrl
    }
    ::log::log debug "@3a {$xns} {[dict get $serviceInfo tnsList url]}"
    if {![dict exists $serviceInfo tnsList url $xns]} {
        set tns [format {tns%d} [incr tnsCount]]
        dict set serviceInfo targetNamespace $tns $xns
        dict set serviceInfo tnsList url $xns $tns
        dict set serviceInfo tnsList tns $tns $tns
    } else {
        set tns [dict get $serviceInfo tnsList url $xns]
    }
    ::log::log debug "@3 TNS count for $xns is $tnsCount {$tns}"

    set prevTnsDict [dict get $serviceInfo tnsList tns]
    dict set serviceInfo tns {}
    foreach itemList [$schemaNode attributes xmlns:*] {
        set ns [lindex $itemList 0]
        set url [$schemaNode getAttribute xmlns:$ns]
        if {[dict exists $serviceInfo tnsList url $url]} {
................................................................................
#
# 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::log error "Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}"
            set result $tns:$type
            return -code error
        }

    }
    return $result

Changes to pkgIndex.tcl. 

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::Client 2.3.2  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.2  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.2  [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Embeded 2.3.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]]

package ifneeded WS::Wub 2.2.1 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.0.0 [list source [file join $dir WubServer.tcl]]

package ifneeded WS::CheckAndBuild 0.0.3 [list source [file join $dir CheckAndBuild.tcl]]







|
|
|










4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded WS::Client 2.3.3  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.3  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.3  [list source [file join $dir Utilities.tcl]]

package ifneeded WS::Embeded 2.3.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::AOLserver 2.0.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.0.0 [list source [file join $dir ChannelServer.tcl]]

package ifneeded WS::Wub 2.2.1 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.0.0 [list source [file join $dir WubServer.tcl]]

package ifneeded WS::CheckAndBuild 0.0.3 [list source [file join $dir CheckAndBuild.tcl]]

Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14