Check-in [cecf30f810]
Not logged in
Home Documentation Downloads Timeline Files Branches Tags Tickets Wiki Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Fixes for incorrect error signalling and to add automatic type casting of abstract to real types.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: cecf30f81093e053d545a14b46bff3513c66dc42
User & Date: gerald 2013-04-09 15:50:04
Context
2013-04-09 15:54
forgot to save changes to Utilities.tcl! check-in: 394de07dfb user: gerald tags: trunk
2013-04-09 15:50
Fixes for incorrect error signalling and to add automatic type casting of abstract to real types. check-in: cecf30f810 user: gerald tags: trunk
2013-03-08 05:19
Updated docs for release 2.3.1 check-in: ce2053ddc1 user: gerald tags: trunk, Release_2.3.1
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl. 

1
2
3
4
5
6
7
8
9
10
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110

111
112
113
114
115
116
117
...
762
763
764
765
766
767
768

769
770
771
772
773
774
775
776
777
778
779
780
....
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
....
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
....
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
....
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
....
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
....
1576
1577
1578
1579
1580
1581
1582

1583


1584
1585


1586
1587
1588
1589
1590
1591
1592
....
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
....
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
....
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
....
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
....
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
....
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
....
3395
3396
3397
3398
3399
3400
3401

3402
3403
3404
3405
3406
3407
3408
....
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2008, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
................................................................................
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

package require Tcl 8.4
package require WS::Utils 2.3 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
package require uri

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

package provide WS::Client 2.3.1

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
................................................................................
        skipHeaderLevel 0
        suppressTargetNS 0
        allowOperOverloading 1
        contentType {text/xml;charset=utf-8}
        UseNS {}
        parseInAttr {}
        genOutAttr {}

        suppressNS {}
        useTypeNs {}
        nsOnChangeOnly {}
    }
    set ::WS::Client::utilsOptionsList {
        UseNS
        parseInAttr
        genOutAttr

        suppressNS
        useTypeNs
        nsOnChangeOnly
    }
}

 
................................................................................
    }
    set serviceArr($serviceName) $serviceInfo

    if {[dict exists $serviceInfo types]} {
        foreach {typeName partList} [dict get $serviceInfo types] {
            set definition [dict get $partList definition]
            set xns [dict get $partList xns]

            if {[string equal [lindex [split $typeName {:}] 1] {}]} {
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition tns1
            } else {
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition $xns
            }
        }
    }

    if {[dict exists $serviceInfo simpletypes]} {
        foreach partList [dict get $serviceInfo simpletypes] {
            lassign $partList typeName definition
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
................................................................................
            "Operation '$operationName' for service '$serviceName' is overloaded, you must call one of its clones."
    }

    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
................................................................................
        set hadError 1
    } else {
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {
            SaveAndSetOptions $serviceName
            if {[catch {set body [$outTransform $serviceName $operationName REPLY $body]} err]} {
                RestoreSavedOptions $serviceName
                return -code error -errorcode $::errorCode -errorlist $::errorList $err
            } else {
                RestoreSavedOptions $serviceName
            }
        }
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorlist $::errorList $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            ::log::log debug "Reply was $body"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
................................................................................
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
................................................................................
            "Unknown service '$serviceName'"
    }

    set serviceInfo $serviceArr($serviceName)

    set procList {}

    foreach operationName [dict get $serviceInfo operList] {
        if {[dict get $serviceInfo operation $operationName cloned]} {
            continue
        }
        set procName $operationName
        set argList {}
        foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
            set inputHeaderType [lindex $inputHeaderTypeItem 0]
................................................................................
            set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
            set headerFields [dict keys [dict get $headerTypeInfo definition]]
            if {![string equal $headerFields {}]} {
                lappend argList [lsort -dictionary $headerFields]
            }
        }
        set inputMsgType [dict get $serviceInfo operation $operationName inputs]

        set inputFields [dict keys [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType] definition]]


        if {![string equal $inputFields {}]} {
            lappend argList [lsort -dictionary $inputFields]


        }
        set argList [join $argList]

        append procList "\n\t$procName $argList"
    }
    return "$procList\n"
}
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorlist $::errorList $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
................................................................................
                ::WS::Utils::setAttr $headerData $attrList
            }
        }
        ::WS::Utils::convertDictToType Client $serviceName $doc $headerData $argList $inputHeaderType
    }

    $env appendChild [$doc createElement "SOAP-ENV:Body" bod]
    puts "set xns \[dict get \[::WS::Utils::GetServiceTypeDef Client $serviceName $msgType\] xns\]"
    puts "\t [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType]"
    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]
    if {[info exists tnsArray($xns)]} {
        set xns $tnsArray($xns)
    }
    set typeInfo [split $msgType {:}]
    if {[llength $typeInfo] != 1} {
        set xns [lindex $typeInfo 0]
        set msgType [lindex $typeInfo 1]
    }

    if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {
        set reply $bod
    } else {
        ::log::log debug [list $bod appendChild \[$doc createElement $xns:$msgType reply\]]
        $bod appendChild [$doc createElement $xns:$msgType reply]
    }

    ::WS::Utils::convertDictToType Client $serviceName $doc $reply $argList $xns:$msgType

    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {:}] end] {=}] end]
    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
................................................................................
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
................................................................................
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorlist $::errorList $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            ::log::log debug "Reply was [::http::data $token]"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
................................................................................
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo object $objectName location]
    SaveAndSetOptions $serviceName
    if {catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorlist $::errorList $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
................................................................................

    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]

    ::log::log debug "calling [list ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType]"
    set options [::WS::Utils::SetOption]
    ::WS::Utils::SetOption UseNS 0
    ::WS::Utils::SetOption genOutAttr 1

    ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType
    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {;}] end] {=}] end]
    foreach {option value} $options {
        ::WS::Utils::SetOption $option $value
    }

    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorlist $::errorList $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }


|







 







|










|







 







>








>







 







>

|


|







 







|







 







|







 







|







|







 







|







 







|







 







>
|
>
>
|
|
>
>







 







|







 







|
|













|







 







|







 







|







 







|







 







|







 







>







 







|








1
2
3
4
5
6
7
8
9
10
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
...
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
....
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
....
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
....
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
....
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
....
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
....
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
....
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
....
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
....
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
....
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
....
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
....
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
....
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
....
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
................................................................................
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

package require Tcl 8.4
package require WS::Utils 2.3.2 ; # dict, lassign
package require tdom 0.8
package require http 2
package require log
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
................................................................................
        skipHeaderLevel 0
        suppressTargetNS 0
        allowOperOverloading 1
        contentType {text/xml;charset=utf-8}
        UseNS {}
        parseInAttr {}
        genOutAttr {}
        valueAttrCompatiblityMode 1
        suppressNS {}
        useTypeNs {}
        nsOnChangeOnly {}
    }
    set ::WS::Client::utilsOptionsList {
        UseNS
        parseInAttr
        genOutAttr
        valueAttrCompatiblityMode
        suppressNS
        useTypeNs
        nsOnChangeOnly
    }
}

 
................................................................................
    }
    set serviceArr($serviceName) $serviceInfo

    if {[dict exists $serviceInfo types]} {
        foreach {typeName partList} [dict get $serviceInfo types] {
            set definition [dict get $partList definition]
            set xns [dict get $partList xns]
            set isAbstarct [dict get $partList abstract]
            if {[string equal [lindex [split $typeName {:}] 1] {}]} {
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition tns1 $isAbstarct
            } else {
                #set typeName [lindex [split $typeName {:}] 1]
                ::WS::Utils::ServiceTypeDef Client $serviceName $typeName $definition $xns $isAbstarct
            }
        }
    }

    if {[dict exists $serviceInfo simpletypes]} {
        foreach partList [dict get $serviceInfo simpletypes] {
            lassign $partList typeName definition
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
................................................................................
            "Operation '$operationName' for service '$serviceName' is overloaded, you must call one of its clones."
    }

    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo "buildCallquery error -- $err"
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
................................................................................
        set hadError 1
    } else {
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {
            SaveAndSetOptions $serviceName
            if {[catch {set body [$outTransform $serviceName $operationName REPLY $body]} err]} {
                RestoreSavedOptions $serviceName
                return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
            } else {
                RestoreSavedOptions $serviceName
            }
        }
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo "parseResults -- $err"
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            ::log::log debug "Reply was $body"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
................................................................................
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo location]
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildCallquery $serviceName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
................................................................................
            "Unknown service '$serviceName'"
    }

    set serviceInfo $serviceArr($serviceName)

    set procList {}

    foreach operationName [lsort -dictionary [dict get $serviceInfo operList]] {
        if {[dict get $serviceInfo operation $operationName cloned]} {
            continue
        }
        set procName $operationName
        set argList {}
        foreach inputHeaderTypeItem [dict get $serviceInfo operation $operationName soapRequestHeader] {
            set inputHeaderType [lindex $inputHeaderTypeItem 0]
................................................................................
            set headerTypeInfo [::WS::Utils::GetServiceTypeDef Client $serviceName $inputHeaderType]
            set headerFields [dict keys [dict get $headerTypeInfo definition]]
            if {![string equal $headerFields {}]} {
                lappend argList [lsort -dictionary $headerFields]
            }
        }
        set inputMsgType [dict get $serviceInfo operation $operationName inputs]
        if {![string equal $inputMsgType {}]} {
            set inTypeDef [::WS::Utils::GetServiceTypeDef Client $serviceName $inputMsgType]
            if {[dict exists $inTypeDef definition]} {
                set inputFields [dict keys [dict get $inTypeDef definition]]
                if {![string equal $inputFields {}]} {
                    lappend argList [lsort -dictionary $inputFields]
                }
            }
        }
        set argList [join $argList]

        append procList "\n\t$procName $argList"
    }
    return "$procList\n"
}
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
................................................................................
                ::WS::Utils::setAttr $headerData $attrList
            }
        }
        ::WS::Utils::convertDictToType Client $serviceName $doc $headerData $argList $inputHeaderType
    }

    $env appendChild [$doc createElement "SOAP-ENV:Body" bod]
    #puts "set xns \[dict get \[::WS::Utils::GetServiceTypeDef Client $serviceName $msgType\] xns\]"
    #puts "\t [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType]"
    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]
    if {[info exists tnsArray($xns)]} {
        set xns $tnsArray($xns)
    }
    set typeInfo [split $msgType {:}]
    if {[llength $typeInfo] != 1} {
        set xns [lindex $typeInfo 0]
        set msgType [lindex $typeInfo 1]
    }

    if {[dict get $serviceInfo skipLevelWhenActionPresent] && [dict exists $serviceInfo operation $operationName action]} {
        set reply $bod
    } else {
        ::log::log debug "$bod appendChild \[$doc createElement $xns:$msgType reply\]"
        $bod appendChild [$doc createElement $xns:$msgType reply]
    }

    ::WS::Utils::convertDictToType Client $serviceName $doc $reply $argList $xns:$msgType

    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {:}] end] {=}] end]
    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
................................................................................
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
................................................................................
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }
    SaveAndSetOptions $serviceName
    if {[catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            ::log::log debug "Reply was [::http::data $token]"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
................................................................................
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo object $objectName location]
    SaveAndSetOptions $serviceName
    if {catch {set query [buildRestCallquery $serviceName $objectName $operationName $url $argList} err]} {
        RestoreSavedOptions $serviceName
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
    } else {
        RestoreSavedOptions $serviceName
    }
    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
................................................................................

    set xns [dict get [::WS::Utils::GetServiceTypeDef Client $serviceName $msgType] xns]

    ::log::log debug "calling [list ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType]"
    set options [::WS::Utils::SetOption]
    ::WS::Utils::SetOption UseNS 0
    ::WS::Utils::SetOption genOutAttr 1
    ::WS::Utils::SetOption valueAttr {}
    ::WS::Utils::convertDictToType Client $serviceName $doc $body $argList $msgType
    set encoding [lindex [split [lindex [split [dict get $serviceInfo contentType] {;}] end] {=}] end]
    foreach {option value} $options {
        ::WS::Utils::SetOption $option $value
    }

    set xml [format {<?xml version="1.0"  encoding="%s"?>} $encoding]
................................................................................
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {
        SaveAndSetOptions $serviceName
        if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
            RestoreSavedOptions $serviceName
            return -code error -errorcode $::errorCode -errorinfo $::errorInfo $err
        } else {
            RestoreSavedOptions $serviceName
        }
        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }

Changes to ServerSide.tcl. 

1
2
3
4
5
6
7
8
9
10
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2008, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
##                                                                           ##
................................................................................
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

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

package provide WS::Server 2.3.1

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



|







 







|




|








1
2
3
4
5
6
7
8
9
10
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
##                                                                           ##
................................................................................
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################

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 {}
}

Changes to Utilities.tcl. 

1
2
3
4
5
6
7
8
9
10
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
...
119
120
121
122
123
124
125

126
127
128
129
130
131
132
...
325
326
327
328
329
330
331

332
333
334
335
336
337
338
...
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366

367
368
369
370
371
372
373
....
1407
1408
1409
1410
1411
1412
1413




1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
....
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455




1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474




1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
....
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
....
1655
1656
1657
1658
1659
1660
1661






1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672

1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
....
1698
1699
1700
1701
1702
1703
1704

1705
1706
1707
1708
1709
1710
1711
1712
1713
....
1724
1725
1726
1727
1728
1729
1730

1731
1732

1733




1734
1735
1736
1737
1738
1739
1740
1741
....
1762
1763
1764
1765
1766
1767
1768

1769
1770




1771
1772
1773
1774
1775
1776
1777
1778
....
1798
1799
1800
1801
1802
1803
1804

1805
1806
1807
1808
1809
1810
1811
....
1845
1846
1847
1848
1849
1850
1851

1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864





1865
1866
1867
1868
1869
1870
1871
....
1878
1879
1880
1881
1882
1883
1884

1885
1886
1887
1888
1889
1890
1891
1892
1893
....
1902
1903
1904
1905
1906
1907
1908

1909
1910
1911
1912
1913
1914
1915
1916
1917
....
1925
1926
1927
1928
1929
1930
1931

1932



1933
1934
1935
1936
1937
1938
1939
1940
....
1950
1951
1952
1953
1954
1955
1956

1957



1958
1959
1960
1961
1962
1963
1964
1965
....
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
....
3257
3258
3259
3260
3261
3262
3263





3264
3265
3266
3267
3268
3269
3270
....
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2011, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
................................................................................
    }
}

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

package provide WS::Utils 2.3.1

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
................................................................................
        positiveInteger 1
    }
    array set ::WS::Utils::options {
        UseNS 1
        StrictMode error
        parseInAttr 0
        genOutAttr 0

        includeDirectory {}
        suppressNS {}
        useTypeNs 0
        nsOnChangeOnly 0
    }

    set ::WS::Utils::standardAttributes {
................................................................................
#       definition      - The definition of the type's fields.  This consist of one
#                         or more occurence of a field definition.  Each field definition
#                         consist of:  fieldName fieldInfo
#                         Where field info is: {type typeName comment commentString}
#                           typeName can be any simple or defined type.
#                           commentString is a quoted string describing the field.
#       xns             - The namespace

#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::ServiceTypeDef {mode service type definition {xns {}}} {
    ::log::log debug [info level 0]
    variable typeInfo

    if {![string length $xns]} {
        set xns $service
    }
    if {[llength [split $type {:}]] == 1} {
        set type $xns:$type
    }
    dict set typeInfo $mode $service $type definition $definition
    dict set typeInfo $mode $service $type xns $xns

    return;
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
................................................................................
                ::log::log debug "\t\t Replacing: $oldXML"
                set item [GetReferenceNode $root [$item getAttribute href]]
                ::log::log debug "\t\t With: [$item asXML]"
            }
            lappend newItemList $item
        }
        set item $newItemList




        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {$options(parseInAttr)} {
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName {} [$item asText]
                } else {
                    dict set results $partName [$item asText]
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList {} [$row asText]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [$row asText]
                    }
                }
                dict set results $partName $tmp
            }
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                if {$options(parseInAttr)} {




                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName {} [convertTypeToDict $mode $serviceName $item $partType $root]
                } else {
                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root]
                }
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set partType [string trimright $partType {()}]
                set tmp [list]
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}




                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList {} [convertTypeToDict $mode $serviceName $row $partType $root 1]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    if {[dict exists $typeInfo $mode $service $service:$type]} {
        set typeName $service:$type
    } else {
        set typeName $type
    }
    set itemList {}

    if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} {
        set itemList [dict get $typeInfo $mode $service $typeName definition]
        set xns [dict get $typeInfo $mode $service $typeName xns]
    } else {
        set xns $simpleTypes($mode,$service,$typeName)
        set itemList [list $typeName {type string}]
    }
    if {[info exists mutableTypeInfo([list $mode $service $typeName])]} {
        set type [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict]
        set typeInfoList [TypeInfo $mode $service $typeName]
        if {[lindex $typeInfoList 0]} {
            set itemList [dict get $typeInfo $mode $service $typeName definition]
            set xns [dict get $typeInfo $mode $service $typeName xns]
        } else {
            set xns $simpleTypes($mode,$service,$typeName)
            set itemList [list $type {type string}]
................................................................................
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}"






        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
                } else {
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {

                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {![string equal $attr {}]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        ::log::log debug "<$row> '$dictList'"

                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {![string equal $attr {}]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
                } else {
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {

                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"

                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {




                        if {![string equal $attr  {}]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                    if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]

                        #::log::log debug "<$row> '$dictList'"
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {




                            if {![string equal $attr  {}]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
        #if {$options(genOutAttr)} {
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }

    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable simpleTypes


    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        set xns $simpleTypes($mode,$service,$type)
        set itemList [list $type {type string}]
    }
    ::log::log debug "\titemList is {$itemList}"
    foreach {itemName itemDef} $itemList {
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}"
        set itemType [dict get $itemDef type]





        set typeInfoList [TypeInfo $mode $service $itemType]
        if {![dict exists $dict $itemName]} {
            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1} {
................................................................................
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]

                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {[string equal $attr  {}]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                ## Simple array
                ##
                set dataList [dict get $dict $itemName]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retNode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]

                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr  {}]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retnode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]

                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {



                        if {[string equal $attr  {}]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType ()]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retnode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]

                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {



                            if {[string equal $attr  {}]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
            }
        }
    }
    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"
        ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns
    } elseif {!$nodeFound} {
        #puts "Defined $typeName as simple type"
        ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment {}] $tns
    } else {
        set xml [string trim [$node asXML]]
        return \
            -code error \
................................................................................
    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::log debug "Elemental Type is $typeName"
    set partList {}
    set partType {}





    set elements [$node selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
    ::log::log debug "\t element list is {$elements} partList {$partList}"
    foreach element $elements {
        set ::elementName [$element asXML]
        ::log::log debug "\t\t Processing element {[$element nodeName]}"
        set elementsFound 1
        set typeAttribute ""
................................................................................
                lappend partList $typeName [list type $partType comment {}]
            }
        } else {
            lappend partList $typeName [list type [string trimright ${partType} {()}]() comment {}]
        }
    }
    if {[llength $partList]} {
        ::WS::Utils::ServiceTypeDef $mode $serviceName $tns:$typeName $partList $tns
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
            ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $tns:$typeName  $partList $tns
            dict set results simpletypes $tns:$typeName $partList
        }
    }


|







 







|







 







>







 







>







 







|











>







 







>
>
>
>











|







 







|












>
>
>
>





|













>
>
>
>





|







 







<








|







 







>
>
>
>
>
>











>



|







 







>

|







 







>


>

>
>
>
>
|







 







>


>
>
>
>
|







 







>







 







>













>
>
>
>
>







 







>

|







 







>

|







 







>

>
>
>
|







 







>

>
>
>
|







 







|







 







>
>
>
>
>







 







|








1
2
3
4
5
6
7
8
9
10
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
...
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
...
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
....
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
....
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
....
1614
1615
1616
1617
1618
1619
1620

1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
....
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
....
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
....
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
....
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
....
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
....
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
....
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
....
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
....
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
....
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
....
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
....
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
....
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470

###############################################################################
##                                                                           ##
##  Copyright (c) 2006-2013, Gerald W. Lester                                ##
##  Copyright (c) 2008, Georgios Petasis                                     ##
##  Copyright (c) 2006, Visiprise Software, Inc                              ##
##  Copyright (c) 2006, Arnulf Wiedemann                                     ##
##  Copyright (c) 2006, Colin McCormack                                      ##
##  Copyright (c) 2006, Rolf Ade                                             ##
##  Copyright (c) 2001-2006, Pat Thoyts                                      ##
##  All rights reserved.                                                     ##
................................................................................
    }
}

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 {}
................................................................................
        positiveInteger 1
    }
    array set ::WS::Utils::options {
        UseNS 1
        StrictMode error
        parseInAttr 0
        genOutAttr 0
        valueAttrCompatiblityMode 1
        includeDirectory {}
        suppressNS {}
        useTypeNs 0
        nsOnChangeOnly 0
    }

    set ::WS::Utils::standardAttributes {
................................................................................
#       definition      - The definition of the type's fields.  This consist of one
#                         or more occurence of a field definition.  Each field definition
#                         consist of:  fieldName fieldInfo
#                         Where field info is: {type typeName comment commentString}
#                           typeName can be any simple or defined type.
#                           commentString is a quoted string describing the field.
#       xns             - The namespace
#       abstract        - Boolean indicating if this is an abstract, and hence mutable type
#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
................................................................................
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::ServiceTypeDef {mode service type definition {xns {}} {abstract {false}}} {
    ::log::log debug [info level 0]
    variable typeInfo

    if {![string length $xns]} {
        set xns $service
    }
    if {[llength [split $type {:}]] == 1} {
        set type $xns:$type
    }
    dict set typeInfo $mode $service $type definition $definition
    dict set typeInfo $mode $service $type xns $xns
    dict set typeInfo $mode $service $type abstract $abstract
    return;
}

###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
#                           that you update this header block. Thanks.
................................................................................
                ::log::log debug "\t\t Replacing: $oldXML"
                set item [GetReferenceNode $root [$item getAttribute href]]
                ::log::log debug "\t\t With: [$item asXML]"
            }
            lappend newItemList $item
        }
        set item $newItemList
        set isAbstract false
        if {[dict exists $typeInfo $mode $serviceName $partType abstract]} {
            set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
        }
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {$options(parseInAttr)} {
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $options(valueAttr) [$item asText]
                } else {
                    dict set results $partName [$item asText]
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $options(valueAttr) [$row asText]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [$row asText]
                    }
                }
                dict set results $partName $tmp
            }
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                if {$options(parseInAttr)} {
                    if {$isAbstract && [$item hasAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]} {
                        set partType [$item getAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]
                        $item removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                    }
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $options(valueAttr) [convertTypeToDict $mode $serviceName $item $partType $root]
                } else {
                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root]
                }
            }
            {1 1} {
                ##
                ## Non-simple array
                ##
                set partType [string trimright $partType {()}]
                set tmp [list]
                foreach row $item {
                    if {$options(parseInAttr)} {
                        set rowList {}
                        if {$isAbstract && [$row hasAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]} {
                            set partType [$row getAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type]
                            $row removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                        }
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $options(valueAttr) [convertTypeToDict $mode $serviceName $row $partType $root 1]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    if {[dict exists $typeInfo $mode $service $service:$type]} {
        set typeName $service:$type
    } else {
        set typeName $type
    }
    set itemList {}

    if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} {
        set itemList [dict get $typeInfo $mode $service $typeName definition]
        set xns [dict get $typeInfo $mode $service $typeName xns]
    } else {
        set xns $simpleTypes($mode,$service,$typeName)
        set itemList [list $typeName {type string}]
    }
    if {[info exists mutableTypeInfo([list $mode $service $typeName])]} {
        set typeName [(*)[lindex mutableTypeInfo([list $mode $service $type]) 0] $mode $service $type $xns $dict]
        set typeInfoList [TypeInfo $mode $service $typeName]
        if {[lindex $typeInfoList 0]} {
            set itemList [dict get $typeInfo $mode $service $typeName definition]
            set xns [dict get $typeInfo $mode $service $typeName xns]
        } else {
            set xns $simpleTypes($mode,$service,$typeName)
            set itemList [list $type {type string}]
................................................................................
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}"
        set isAbstract false
        set baseType [string trimright $itemType ()]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        ::log::log notice "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}"
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
                } else {
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {
                    set resultValue {}
                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {![string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        ::log::log debug "<$row> '$dictList'"
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {![string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                ##
                if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                    $parent appendChild [$doc createElement $itemName retNode]
                } else {
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {
                    #::log::log debug "Before 150 useName {$useName} dict {$dict}"
                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                            set itemType $itemXns:$itemType
                        } elseif {![string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                    if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
                        $parent appendChild [$doc createElement $itemName retNode]
                    } else {
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        #::log::log debug "<$row> '$dictList'"
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                                set tmpType $itemXns:$tmpType
                            } elseif {![string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
        #if {$options(genOutAttr)} {
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }
    ::log::log debug "Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]"
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable options

    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        set xns $simpleTypes($mode,$service,$type)
        set itemList [list $type {type string}]
    }
    ::log::log debug "\titemList is {$itemList}"
    foreach {itemName itemDef} $itemList {
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef}"
        set itemType [dict get $itemDef type]
        set isAbstract false
        set baseType [string trimright $itemType ()]
        if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
            set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
        }
        set typeInfoList [TypeInfo $mode $service $itemType]
        if {![dict exists $dict $itemName]} {
            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1} {
................................................................................
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {[string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                ## Simple array
                ##
                set dataList [dict get $dict $itemName]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retNode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
            {1 0} {
                ##
                ## Non-simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retnode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                        } elseif {[string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                ##
                set dataList [dict get $dict $itemName]
                set tmpType [string trimright $itemType ()]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retnode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                            } elseif {[string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
            }
        }
    }
    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"
        ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
    } elseif {!$nodeFound} {
        #puts "Defined $typeName as simple type"
        ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment {}] $tns
    } else {
        set xml [string trim [$node asXML]]
        return \
            -code error \
................................................................................
    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::log debug "Elemental Type is $typeName"
    set partList {}
    set partType {}
    set isAbstractType false
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::log debug "\t Abstract type = $isAbstractType"
    }
    set elements [$node selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
    ::log::log debug "\t element list is {$elements} partList {$partList}"
    foreach element $elements {
        set ::elementName [$element asXML]
        ::log::log debug "\t\t Processing element {[$element nodeName]}"
        set elementsFound 1
        set typeAttribute ""
................................................................................
                lappend partList $typeName [list type $partType comment {}]
            }
        } else {
            lappend partList $typeName [list type [string trimright ${partType} {()}]() comment {}]
        }
    }
    if {[llength $partList]} {
        ::WS::Utils::ServiceTypeDef $mode $serviceName $tns:$typeName $partList $tns $isAbstractType
    } else {
        if {![dict exists $results types $tns:$typeName]} {
            set partList [list base string comment {} xns $tns]
            ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $tns:$typeName  $partList $tns
            dict set results simpletypes $tns:$typeName $partList
        }
    }

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.1  [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Server 2.3.1  [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.3.1  [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.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]]

Fossil 2.9 [3a8abf492a] 2019-06-12 09:41:26