Check-in [1317e4416e]
Not logged in
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:Fix for [4d55a803fd] -- added namespace options into Client Side.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1317e4416ef7387f0cdb267a17a43693cbc01983
User & Date: gerald 2013-03-08 02:57:20
Context
2013-03-08 05:19
Updated docs for release 2.3.1 check-in: ce2053ddc1 user: gerald tags: trunk, Release_2.3.1
2013-03-08 02:57
Fix for [4d55a803fd] -- added namespace options into Client Side. check-in: 1317e4416e user: gerald tags: trunk
2012-11-09 14:34
Updated all docs pages from wiki. Not present wiki pages: clients, Downloads, Pretty Printing a Dictionary Instance check-in: d7188ff2cb user: oehhar tags: trunk, Release_2.3.0
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
..
93
94
95
96
97
98
99














100
101
102
103
104
105
106
...
207
208
209
210
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
...
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
....
1186
1187
1188
1189
1190
1191
1192

1193





1194
1195
1196
1197
1198
1199
1200
....
1308
1309
1310
1311
1312
1313
1314

1315





1316
1317
1318
1319
1320
1321
1322
....
1343
1344
1345
1346
1347
1348
1349

1350




1351


1352





1353
1354
1355
1356
1357
1358
1359
....
1443
1444
1445
1446
1447
1448
1449

1450





1451
1452
1453
1454
1455
1456
1457
....
1694
1695
1696
1697
1698
1699
1700

1701





1702
1703
1704
1705
1706
1707
1708
....
2988
2989
2990
2991
2992
2993
2994

2995





2996
2997
2998
2999
3000
3001
3002
....
3107
3108
3109
3110
3111
3112
3113

3114





3115
3116
3117
3118
3119
3120
3121
....
3136
3137
3138
3139
3140
3141
3142

3143





3144
3145
3146
3147
3148
3149
3150
....
3238
3239
3240
3241
3242
3243
3244

3245





3246
3247
3248
3249
3250
3251
3252
....
3527
3528
3529
3530
3531
3532
3533

3534





3535
3536
3537
3538
3539
3540
3541
....
3552
3553
3554
3555
3556
3557
3558


















































































































package require uri

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

package provide WS::Client 2.3.0

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
................................................................................
    array set ::WS::Client::options {
        skipLevelWhenActionPresent 0
        skipLevelOnReply 0
        skipHeaderLevel 0
        suppressTargetNS 0
        allowOperOverloading 1
        contentType {text/xml;charset=utf-8}














    }
}

 
###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
................................................................................
    dict set serviceArr($serviceName) targetNamespace tns1 $target
    dict set serviceArr($serviceName) name $serviceName
    dict set serviceArr($serviceName) location $url
    dict set serviceArr($serviceName) style $type
    dict set serviceArr($serviceName) imports {}
    dict set serviceArr($serviceName) inTransform {}
    dict set serviceArr($serviceName) outTransform {}
    dict set serviceArr($serviceName) skipLevelWhenActionPresent $options(skipLevelWhenActionPresent)
    dict set serviceArr($serviceName) skipLevelOnReply $options(skipLevelOnReply)
    dict set serviceArr($serviceName) skipHeaderLevel $options(skipHeaderLevel)
    dict set serviceArr($serviceName) suppressTargetNS $options(suppressTargetNS)
    dict set serviceArr($serviceName) contentType $options(contentType)

    foreach {name value} $args {
        set name [string trimleft $name {-}]
        dict set serviceArr($serviceName) $name $value
    }

    ::log::log debug "Setting Target Namespace tns1 as $target"
    if {[dict exists $serviceArr($serviceName) xns]} {
................................................................................
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::Config {serviceName item {value {}}} {
    variable serviceArr


    set serviceInfo $serviceArr($serviceName)
    switch -exact -- $item {
        contentType -
        suppressTargetNS -
        skipLevelOnReply -
        skipHeaderLevel -
        skipLevelWhenActionPresent -
        location -
        targetNamespace {
            ##
            ## Valid, so do nothing
            ##
        }
        default {

            return -code error "Uknown option '$item'"
        }
    }

    if {![string equal $value {}]} {
        dict set serviceInfo $item $value
        set serviceArr($serviceName) $serviceInfo
    }

................................................................................
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    set url [dict get $serviceInfo location]

    set query [buildCallquery $serviceName $operationName $url $argList]





    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
................................................................................
        return \
            -code error \
            -errorcode [list WS CLIENT MUSTCALLCLONE [list $serviceName $operationName]] \
            "Operation '$operationName' for service '$serviceName' is overloaded, you must call one of its clones."
    }

    set url [dict get $serviceInfo location]

    set query [buildCallquery $serviceName $operationName $url $argList]





    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[dict exists $serviceInfo operation $operationName action]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
................................................................................
        }
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {
        set outTransform [dict get $serviceInfo outTransform]
        if {![string equal $outTransform {}]} {

            set body [$outTransform $serviceName $operationName REPLY $body]




        }


        set hadError [catch {parseResults $serviceName $operationName $body} results]





        if {$hadError} {
            ::log::log debug "Reply was $body"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo location]

    set query [buildCallquery $serviceName $operationName $url $argList]





    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -headers [string map {\{ \" \} \"} $headers] \
                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd] \
................................................................................
    ::log::log info "\nReceived: $body"
    if {![string equal [::http::status $token] ok] ||
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {

        set hadError [catch {parseResults $serviceName $operationName $body} results]





        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }

    ##
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }

    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]





    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
    } else {
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        set url $location
    } else {
        set url [dict get $serviceInfo object $objectName location]
    }

    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]





    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    if {[llength $headers]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
    } else {
................................................................................
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [::http::error $token]
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        set hadError 1
    } else {

        set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]





        if {$hadError} {
            ::log::log debug "Reply was [::http::data $token]"
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }
    ::http::cleanup $token
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    if {[dict exists $serviceInfo headers]} {
        set headers [concat $headers [dict get $serviceInfo headers]]
    }
    set url [dict get $serviceInfo object $objectName location]

    set query [buildRestCallquery $serviceName $objectName $operationName $url $argList]





    if {[llength $headers]} {
        ::log::log info [list \
            ::http::geturl $url \
                -query $query \
                -type [dict get $serviceInfo contentType] \
                -headers [string map {\{ \" \} \"} $headers] \
                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd] \
................................................................................
    ::log::log info "\nReceived: $body"
    if {![string equal [::http::status $token] ok] ||
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set hadError 1
        set errorInfo [::http::error $token]
    } else {

        set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]





        if {$hadError} {
            set errorCode $::errorCode
            set errorInfo $::errorInfo
        }
    }

    ##
................................................................................

    ##
    ## All done
    ##
    ::http::cleanup $token
    return;
}
























































































































|







 







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







 







|
<
<
<
|
>







 







>


<
|
<
<
<
<
<
|
<
<
<
<
<
>
|
<







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
|
>
>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
|
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
...
221
222
223
224
225
226
227
228



229
230
231
232
233
234
235
236
237
...
279
280
281
282
283
284
285
286
287
288

289





290





291
292

293
294
295
296
297
298
299
....
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
....
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
....
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
....
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
....
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
....
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
....
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
....
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
....
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
....
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
....
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
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
................................................................................
    array set ::WS::Client::options {
        skipLevelWhenActionPresent 0
        skipLevelOnReply 0
        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
    }
}

 
###########################################################################
#
# Public Procedure Header - as this procedure is modified, please be sure
................................................................................
    dict set serviceArr($serviceName) targetNamespace tns1 $target
    dict set serviceArr($serviceName) name $serviceName
    dict set serviceArr($serviceName) location $url
    dict set serviceArr($serviceName) style $type
    dict set serviceArr($serviceName) imports {}
    dict set serviceArr($serviceName) inTransform {}
    dict set serviceArr($serviceName) outTransform {}
    foreach item [array names options] {



        dict set serviceArr($serviceName) $item $options($item)
    }
    foreach {name value} $args {
        set name [string trimleft $name {-}]
        dict set serviceArr($serviceName) $name $value
    }

    ::log::log debug "Setting Target Namespace tns1 as $target"
    if {[dict exists $serviceArr($serviceName) xns]} {
................................................................................
# -------  ----------  ----------   -------------------------------------------
#       1  04/14/2009  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::Config {serviceName item {value {}}} {
    variable serviceArr
    variable options

    set serviceInfo $serviceArr($serviceName)

    set validOptionList [array names options]





    lappend validOptionList location targetNamespace





    if {[lsearch -exact $validOptionList $item] == -1} {
        return -code error "Uknown option '$item'"

    }

    if {![string equal $value {}]} {
        dict set serviceInfo $item $value
        set serviceArr($serviceName) $serviceInfo
    }

................................................................................
    if {![dict exists $serviceInfo operation $operationName]} {
        return \
            -code error \
            -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]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
................................................................................
        return \
            -code error \
            -errorcode [list WS CLIENT MUSTCALLCLONE [list $serviceName $operationName]] \
            "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]} {
        lappend headers  SOAPAction [dict get $serviceInfo operation $operationName action]
    }
    if {[llength $headers]} {
................................................................................
        }
        set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
        set errorInfo {}
        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
        }
    }
    ::http::cleanup $token
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    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 \
                -type [dict get $serviceInfo contentType] \
                -headers [string map {\{ \" \} \"} $headers] \
                -command [list ::WS::Client::asyncCallDone $serviceName $operationName $succesCmd $errorCmd] \
................................................................................
    ::log::log info "\nReceived: $body"
    if {![string equal [::http::status $token] ok] ||
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        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
        }
    }

    ##
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
    } else {
................................................................................
            "Unknown operation '$operationName' for object '$objectName' of service '$serviceName'"
    }
    if {![string equal $location {}]} {
        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]} {
        ::log::log info [list ::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
        set token [::http::geturl $url -query $query -type [dict get $serviceInfo contentType] -headers [string map {\{ \" \} \"} $headers]]
    } else {
................................................................................
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        ::log::log debug "\tHTTP error [array get $token]"
        set results [::http::error $token]
        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
        }
    }
    ::http::cleanup $token
................................................................................
            -errorcode [list WS CLIENT UNKOPER [list $serviceName $objectName $operationName]] \
            "Unknown operation '$operationName' for service '$serviceName'"
    }
    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 \
                -type [dict get $serviceInfo contentType] \
                -headers [string map {\{ \" \} \"} $headers] \
                -command [list ::WS::Client::asyncRestCallDone $serviceName $operationName $succesCmd $errorCmd] \
................................................................................
    ::log::log info "\nReceived: $body"
    if {![string equal [::http::status $token] ok] ||
        ([::http::ncode $token] != 200 && [string equal $body {}])} {
        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
        }
    }

    ##
................................................................................

    ##
    ## All done
    ##
    ::http::cleanup $token
    return;
}


###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::asyncRestobCallDone
#
# Description : Save the global options of the utilities package and
#               set them for how this service needs them.
#
# Arguments :
#    serviceName        - the name of the service called
#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/06/2012  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::SaveAndSetOptions {serviceName} {
    variable serviceArr
    variable utilsOptionsList

    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    set savedDict {}
    foreach item $utilsOptionsList {
        if {[dict exists $serviceInfo $item] && [string length [set value [dict get $serviceInfo $item]]]} {
            dict set savedDict $item [::WS::Utils::SetOption $item]
            ::WS::Utils::SetOption $item $value
        }
    }
    dict set serviceArr($serviceName) UtilsSavedOptions $savedDict
    return;
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
#
#>>BEGIN PRIVATE<<
#
# Procedure Name : ::WS::Client::RestoreSavedOptions
#
# Description : Restore the saved global options of the utilities package.
#
# Arguments :
#    serviceName        - the name of the service called
#
# Returns : Nothing
#
# Side-Effects : None
#
# Exception Conditions : None
#
# Pre-requisite Conditions : None
#
# Original Author : Gerald W. Lester
#
#>>END PRIVATE<<
#
# Maintenance History - as this file is modified, please be sure that you
#                       update this segment of the file header block by
#                       adding a complete entry at the bottom of the list.
#
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/06/2012  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Client::RestoreSavedOptions {serviceName} {
    variable serviceArr

    if {![info exists serviceArr($serviceName)]} {
        return \
            -code error \
            -errorcode [list WS CLIENT UNKSRV $serviceName] \
            "Unknown service '$serviceName'"
    }
    set serviceInfo $serviceArr($serviceName)
    set savedDict {}
    foreach {item value} [dict get $serviceInfo UtilsSavedOptions] {
        ::WS::Utils::SetOption $item $value
    }
    dict set serviceArr($serviceName) UtilsSavedOptions {}
    return;
}

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 ; # provides dict
package require html
package require log
package require tdom

package provide WS::Server 2.3.0

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

Changes to Utilities.tcl.

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    }
}

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

package provide WS::Utils 2.3.0

namespace eval ::WS {}

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






|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    }
}

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

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