Check-in [150950db68]
Not logged in

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

Overview
Comment:Reduce non logging log impact by only building log message when logging. Requires tcllib log package 1.4 or included emulation. Ticket [93ebedfa]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:150950db68b9163ae319eb252ff6005ada55b823af946bfb3720b15df50dd74f
User & Date: oehhar 2018-02-20 14:20:43
References
2018-02-20 14:23 Closed ticket [93ebedfa4a]: Replace log package by logger package plus 2 other changes artifact: c7f94a1d2f user: oehhar
Context
2018-05-28 11:16
Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2 check-in: e406ab9e21 user: oehhar tags: trunk
2018-02-20 21:31
First step to parse complex abstract type in wsdl. Bug [584bfb7727] check-in: 6975d0e818 user: oehhar tags: bug584bfb7727-abstract-type
2018-02-20 14:20
Reduce non logging log impact by only building log message when logging. Requires tcllib log package 1.4 or included emulation. Ticket [93ebedfa] check-in: 150950db68 user: oehhar tags: trunk
2018-01-08 17:37
Set package version to release version 2.5.0 check-in: 53f12a2aa1 user: oehhar tags: trunk, Release_2.5.0
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Utilities.tcl.

52
53
54
55
56
57
58




















59
60
61
62
63
64
65
66
67
68
69
...
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
...
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
...
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
...
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
...
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
....
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
....
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
....
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
....
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
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
....
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
....
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
....
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
....
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
....
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
....
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
....
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
....
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
....
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
....
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
....
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
....
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
....
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
....
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
....
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
....
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
....
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
....
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
....
2886
2887
2888
2889
2890
2891
2892







2893



















2894




2895
2896
2897
2898
2899
2900
2901
2902

2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935

2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
....
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
....
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
....
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
....
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
....
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
....
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
....
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
....
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
....
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
....
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
....
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
....
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
....
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
....
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
....
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
....
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
....
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
....
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
....
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
....
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
....
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
....
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
....
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
....
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
....
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
....
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
....
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
....
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
....
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
....
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
            uplevel 1 [list set $var [lindex $inList $i]]
        }
        return [lrange $inList $numArgs end]
    }
}

package require log




















package require tdom 0.8
package require struct::set

package provide WS::Utils 2.4.0

namespace eval ::WS {}

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

    if {[llength $args] == 0} {
        ::log::log debug {Return all options}
        return [array get options]
    } elseif {[llength $args] == 1} {
        set opt [lindex $args 0]
        ::log::log debug "One Option {$opt}"
        if {[info exists options($opt)]} {
            return $options($opt)
        } else {
            ::log::log debug "Unkown option {$opt}"
            return \
                -code error \
                -errorcode [list WS CLIENT UNKOPTION $opt] \
                "Unknown option'$opt'"
        }
    } elseif {([llength $args] % 2) == 0} {
        ::log::log debug {Multiple option pairs}
        foreach {opt value} $args {
            if {[info exists options($opt)]} {
                ::log::log debug "Setting Option {$opt} to {$value}"
                set options($opt) $value
            } else {
                ::log::log debug "Unkown option {$opt}"
                return \
                    -code error \
                    -errorcode [list WS CLIENT UNKOPTION $opt] \
                    "Unknown option'$opt'"
            }
        }
    } else {
        ::log::log debug "Bad number of arguments {$args}"
        return \
            -code error \
            -errorcode [list WS CLIENT INVARGCNT $args] \
            "Invalid argument count'$args'"
    }
    return;
}
................................................................................
# 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
................................................................................
#
#
###########################################################################
proc ::WS::Utils::ServiceSimpleTypeDef {mode service type definition {xns {tns1}}} {
    variable simpleTypes
    variable typeInfo

    ::log::log debug [info level 0]
    if {![dict exists $definition xns]} {
        set simpleTypes($mode,$service,$type) [concat $definition xns $xns]
    } else {
        set simpleTypes($mode,$service,$type) $definition
    }
    if {[dict exists $typeInfo $mode $service $type]} {
        ::log::log debug "\t Unsetting typeInfo $mode $service $type"
        ::log::log debug "\t Was [dict get $typeInfo $mode $service $type]"
        dict unset typeInfo $mode $service $type
    }
    return;
}

###########################################################################
#
................................................................................
        ::log::log debug "@1"
        set results [dict get $typeInfo $mode $service]
    } else {
        set typeInfoList [TypeInfo $mode $service $type]
        if {[string equal -nocase -length 3 $type {xs:}]} {
            set type [string range $type 3 end]
        }
        ::log::log debug "Type = {$type} typeInfoList = {$typeInfoList}"
        if {[info exists simpleTypes($mode,$service,$type)]} {
            ::log::log debug "@2"
            set results $simpleTypes($mode,$service,$type)
        } elseif {[info exists simpleTypes($type)]} {
            ::log::log debug "@3"
            set results [list type xs:$type xns xs]
        } elseif {[dict exists $typeInfo $mode $service $service:$type]} {
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessImportXml {mode baseUrl xml serviceName serviceInfoVar tnsCountVar} {
    ::log::log debug "Entering ProcessImportXml $mode $baseUrl xml $serviceName $serviceInfoVar $tnsCountVar"
    upvar 1 $serviceInfoVar serviceInfo
    upvar 1 $tnsCountVar tnsCount
    variable currentSchema
    variable xsltSchemaDom

    set first [string first {<} $xml]
    if {$first > 0} {
................................................................................
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
    variable xsltSchemaDom
    variable nsList
    variable options
    variable includeArr

    ::log::log debug "ProcessIncludes base: {$baseUrl} inculde: {$includePath}"

    set includeNodeList [concat \
                            [$rootNode selectNodes -namespaces $nsList descendant::xs:include] \
                            [$rootNode selectNodes -namespaces $nsList descendant::w:include] \
    ]
    set inXml [$rootNode asXML]
    set included 0
    foreach includeNode $includeNodeList {
        ::log::log debug "\t Processing Include [$includeNode asXML]"
        if {[$includeNode hasAttribute schemaLocation]} {
            set urlTail [$includeNode getAttribute schemaLocation]
            set url [::uri::resolve $baseUrl  $urlTail]
        } elseif {[$includeNode hasAttribute location]} {
            set url [$includeNode getAttribute location]
            set urlTail [file tail [dict get [::uri::split $url] path]]
        } else {
            continue
        }
        if {[lsearch -exact $includePath $url] != -1} {
            log::log warning "Include loop detected: [join $includePath { -> }]"
            continue
        } elseif {[info exists includeArr($url)]} {
            continue
        } else {
            set includeArr($url) 1
        }
        incr included
        ::log::log info "\t Including {$url} from base {$baseUrl}"
        switch -exact -- [dict get [::uri::split $url] scheme] {
            file {
                upvar #0 [::uri::geturl $url] token
                set xml $token(data)
                unset token
            }
            https -
            http {
                set ncode -1
                catch {
                    ::log::log info [list ::http::geturl $url]
                    set token [::http::geturl $url]
                    ::http::wait $token
                    set ncode [::http::ncode $token]
                    set xml [::http::data $token]
                    ::log::log info "Received Ncode = ($ncode), $xml"
                    ::http::cleanup $token
                }
                if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
                    return \
                        -code error \
                        -errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
                        "HTTP get of import file failed '$url'"
................................................................................
        $parent appendChild [$doc createElement xs:schema schema]
    }
    $schema setAttribute \
        elementFormDefault qualified \
        targetNamespace $targetNamespace

    foreach baseType [lsort -dictionary [array names typeArr]] {
        ::log::log debug "Outputing $baseType"
        $schema appendChild [$doc createElement xs:element elem]
        set name [lindex [split $baseType {:}] end]
        $elem setAttribute name $name
        $elem setAttribute type $baseType
        $schema appendChild [$doc createElement xs:complexType comp]
        $comp setAttribute name $name
        $comp appendChild [$doc createElement xs:sequence seq]
        set baseTypeInfo [dict get $localTypeInfo $baseType definition]
        ::log::log debug "\t parts {$baseTypeInfo}"
        foreach {field tmpTypeInfo} $baseTypeInfo {
            $seq appendChild  [$doc createElement xs:element tmp]
            set tmpType [dict get $tmpTypeInfo type]
            ::log::log debug "Field $field of $tmpType"
            foreach {name value} [getTypeWSDLInfo $mode $serviceName $field $tmpType] {
                $tmp setAttribute $name $value
            }
        }
    }
}

................................................................................

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set xsiNsUrl {http://www.w3.org/2001/XMLSchema-instance}
    ::log::log debug [list ::WS::Utils::convertTypeToDict $mode $serviceName $node $type $root $isArray]
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
    } elseif {[dict exists $typeInfo $mode $serviceName $serviceName:$type]} {
        set typeName $serviceName:$type
    } else {
        ##
        ## Assume this is a simple type
................................................................................
            set results [$node asXML]
        } else {
            set results [$node asText]
        }
        return $results
    }
    set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
    ::log::log debug "\t type def = {$typeDefInfo}"
    set xns [dict get $typeDefInfo xns]
    if {[$node hasAttribute href]} {
        set node [GetReferenceNode $root [$node getAttribute href]]
    }
    ::log::log debug "\t XML of node is [$node asXML]"
    if {[info exists mutableTypeInfo([list $mode $serviceName $typeName])]} {
        set type [(*)[lindex mutableTypeInfo([list $mode $serviceName $type]) 0] $mode $serviceName $typeName $xns $node]
        set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
        ::log::log debug "\t type def replaced with = {$typeDefInfo}"
    }
    set results {}
    #if {$options(parseInAttr)} {
    #    foreach attr [$node attributes] {
    #        if {[llength $attr] == 1} {
    #            dict set results $attr [$node getAttribute $attr]
    #        }
    #    }
    #}
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    set arrayOverride [expr {$isArray && ([llength $partsList] == 1)}]
    foreach partName $partsList {
        set partType [dict get $typeDefInfo definition $partName type]
        set partType [string trimright $partType {?}]
        if {[dict exists $typeDefInfo definition $partName allowAny] && [dict get $typeDefInfo definition $partName allowAny]} {
            set allowAny 1
        } else {
................................................................................
            set typeInfo $savedTypeInfo
            continue
        }
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set tmpTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
        ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList"
        ##
        ## Try for fully qualified name
        ##
        ::log::log debug "Trying #1 [list $node selectNodes $partXns:$partName]"
        if {[catch {llength [set item [$node selectNodes $partXns:$partName]]} len] || ($len == 0)} {
            ::log::log debug "Trying #2 [list $node selectNodes $xns:$partName]"
            if {[catch {llength [set item [$node selectNodes $xns:$partName]]} len] || ($len == 0)} {
                ##
                ## Try for unqualified name
                ##
                ::log::log debug "Trying #3 [list $node selectNodes $partName]"
                if {[catch {llength [set item [$node selectNodes $partName]]} len] || ($len == 0)} {
                    ::log::log debug "Trying #4 -- search of children"
                    set item {}
                    set matchList [list $partXns:$partName  $xns:$partName $partName]
                    foreach childNode [$node childNodes] {
                        set nodeType [$childNode nodeType]
                        ::log::log debug "\t\t Looking at {[$childNode localName],[$childNode nodeName]} ($allowAny,$isArray,$nodeType,$partName)"
                        # From SOAP1.1 Spec:
                        #    Within an array value, element names are not significant
                        # for distinguishing accessors. Elements may have any name.
                        # Here we don't need check the element name, just simple check
                        # it's a element node
                        if {$allowAny  || ($arrayOverride && [string equal $nodeType "ELEMENT_NODE"])} {
                            ::log::log debug "\t\t Found $partName [$childNode asXML]"
                            lappend item $childNode
                        }
                    }
                    if {![string length $item]} {
                        ::log::log debug "\tSkipping"
                        continue
                    }
                } else {
                    ::log::log debug "\t\t Found [llength $item] $partName"
                }
            } else {
                ::log::log debug "\t\t Found [llength $item] $partName"
            }
        } else {
            ::log::log debug "\t\t Found [llength $item] $partName"
        }
        set origItemList $item
        set newItemList {}
        foreach item $origItemList {
            if {[$item hasAttribute href]} {
                set oldXML [$item asXML]
                ::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]
................................................................................
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }
        }
    }
    ::log::log debug [list Leaving ::WS::Utils::convertTypeToDict with $results]
    return $results
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0} {enforceRequired 0}} {
    ::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type"
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs

    if {!$options(UseNS)} {
................................................................................
    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    set type [string trimright $type {?}]
    ::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 xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns]
            } else {
              error "Simple type cannot be found: $typeName"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList} in $xns"
    set entryNs $currentNs
    if {!$forceNs} {
        set currentNs $xns
    }
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        ::log::log debug "Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]"
        if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
            ::log::log debug "Neither {$itemName} nor {$baseName} are in dictionary {$dict}, skipping"
            # If required parameters are being enforced and this field is not optional, throw an error
            if {$enforceRequired && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        } elseif {[dict exists $dict $baseName]} {
            set useName $baseName
................................................................................
        }
        if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
            set itemXns {}
        }
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                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 debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}"
        # Strip the optional flag off the typeInfoList
        set typeInfoList [lrange $typeInfoList 0 1]
        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 $row]
                        ::log::log debug "<$row> '$dictList'"
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr $valueAttr]} {
                                set resultValue [dict get $row $attr]
                            } elseif {[string match {::*} $attr]} {
                                set baseAttr [string range $attr 2 end]
                                set attrValue [dict get $row $attr]
................................................................................
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }
    set currentNs $entryNs
    ::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.
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/23/2011  J.Lawson     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type {enforceRequired 0}} {
    ::log::log debug "Entering ::WS::Utils::convertDictToJson $mode $service $doc {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable simpleTypesJson
    variable options
    variable standardAttributes

    set typeInfoList [TypeInfo $mode $service $type]
................................................................................
        set typeInfoList [TypeInfo $mode $service $typeName]
        if {[lindex $typeInfoList 0]} {
            set itemList [dict get $typeInfo $mode $service $typeName definition]
        } else {
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList}"
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType = {$itemType}"
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        if {![dict exists $dict $itemName]} {
            if {$enforceRequired && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        }
................................................................................

        if {[info exists simpleTypesJson([string trimright $itemType {()?}])]} {
            set yajlType $simpleTypesJson([string trimright $itemType {()?}])
        } else {
            set yajlType "string"
        }

        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}"
        set typeInfoList [lrange $typeInfoList 0 1]
        switch $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set resultValue [dict get $dict $itemName]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes

    if {$options(valueAttrCompatiblityMode)} {
................................................................................
        } elseif {[info exists simpleTypes($mode,$service,$currentNs:$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$currentNs:$type) xns]
        } else {
          error "Simple type cannot be found: $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 1]
................................................................................
            }
            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::log debug "key = {$key} standardAttributes = {$standardAttributes}"
            }
        }
        ::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}"
        set typeInfoList [lrange $typeInfoList 0 1]
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToEncodedType {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToEncodedType $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable options


    set typeInfoList [TypeInfo $mode $service $type]
    ::log::log debug "\t typeInfoList = {$typeInfoList}"
    set type [string trimright $type {?}]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        if {[info exists simpleTypes($mode,$service,$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$type) xns]
................................................................................
              set xns [dict get $simpleTypes($mode,$service,$type) xns]
            } else {
              error "Simple type cannot be found: $type"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::log debug "\titemList is {$itemList} in $xns"
    foreach {itemName itemDef} $itemList {
        set itemType [string trimright [dict get $itemList $itemName type] {?}]
        set typeInfoList [TypeInfo $mode $service $itemType]
        ::log::log debug "\t\t Looking for {$itemName} in {$dict}"
        if {![dict exists $dict $itemName]} {
            ::log::log debug "\t\t Not found, skipping"
            continue
        }
        ::log::log debug "\t\t Type info is {$typeInfoList}"
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $xns $options(suppressNS)]} {
                    $parent appendChild [$doc createElement $itemName retNode]
................................................................................
#
#
###########################################################################
proc ::WS::Utils::parseDynamicType {mode serviceName node type} {
    variable typeInfo
    variable nsList

    ::log::log debug [list ::WS::Utils::parseDynamicType $mode $serviceName $node $type]

    foreach child [$node childNodes] {
        ::log::log debug "\t Child $child is [$child nodeName]"
    }

    ##
    ## Get type being defined
    ##
    set schemeNode [$node selectNodes -namespaces $nsList xs:schema]
    set newTypeNode [$node selectNodes -namespaces $nsList  xs:schema/xs:element]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::parseScheme {mode baseUrl schemaNode serviceName serviceInfoVar tnsCountVar} {
    ::log::log debug "Entering :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar"

    upvar 1 $tnsCountVar tnsCount
    upvar 1 $serviceInfoVar serviceInfo
    variable currentSchema
    variable nsList
    variable options
    variable unkownRef

    set currentSchema $schemaNode
    set tmpTargetNs $::WS::Utils::targetNs
    foreach attr [$schemaNode attributes] {
        set value {?}
        catch {set value [$schemaNode getAttribute $attr]}
        ::log::log debug "Attribute $attr = $value"
    }
    if {[$schemaNode hasAttribute targetNamespace]} {
        set xns [$schemaNode getAttribute targetNamespace]
        ::log::log debug "In Parse Scheme, found targetNamespace attribute with {$xns}"
        set ::WS::Utils::targetNs $xns
    } else {
        set xns $::WS::Utils::targetNs
    }
    ::log::log debug "@3a {$xns} {[dict get $serviceInfo tnsList url]}"
    if {![dict exists $serviceInfo tnsList url $xns]} {
        set tns [format {tns%d} [incr tnsCount]]
        dict set serviceInfo targetNamespace $tns $xns
        dict set serviceInfo tnsList url $xns $tns
        dict set serviceInfo tnsList tns $tns $tns
    } else {
        set tns [dict get $serviceInfo tnsList url $xns]
    }
    ::log::log debug "@3 TNS count for $xns is $tnsCount {$tns}"

    set prevTnsDict [dict get $serviceInfo tnsList tns]
    dict set serviceInfo tns {}
    foreach itemList [$schemaNode attributes xmlns:*] {
        set ns [lindex $itemList 0]
        set url [$schemaNode getAttribute xmlns:$ns]
        if {[dict exists $serviceInfo tnsList url $url]} {
................................................................................
    ##
    ## Process the scheme in multiple passes to handle forward references and extensions
    ##
    set pass 1
    set lastUnknownRefCount 0
    array unset unkownRef
    while {($pass == 1) || ($lastUnknownRefCount != [array size unkownRef])} {
        ::log::log debug  "Pass $pass over schema"
        incr pass
        set lastUnknownRefCount [array size unkownRef]
        array unset unkownRef

        foreach element [$schemaNode selectNodes -namespaces $nsList xs:import] {
            if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
                ::log::log notice "Import failed due to: {$msg}.  Trace: $::errorInfo"
            }
        }

        foreach element [$schemaNode selectNodes -namespaces $nsList w:import] {
            if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
                ::log::log notice "Import failed due to: {$msg}.  Trace: $::errorInfo"
            }
        }

        ::log::log debug  "Parsing Element types for $xns as $tns"
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
            ::log::log debug "\tprocessing $element"
            if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::log notice "Unhandled error: {$msg}.  Trace: $::errorInfo"
            }
        }

        ::log::log debug  "Parsing Attribute types for $xns as $tns"
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
            ::log::log debug "\tprocessing $element"
            if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::log notice "Unhandled error: {$msg}.  Trace: $::errorInfo"
            }
        }

        ::log::log debug "Parsing Simple types for $xns as $tns"
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
            ::log::log debug "\tprocessing $element"
            if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::log notice "Unhandled error: {$msg}.  Trace: $::errorInfo"
            }
        }

        ::log::log debug  "Parsing Complex types for $xns as $tns"
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
            ::log::log debug "\tprocessing $element"
            if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::log notice "Unhandled error: {$msg}.  Trace: $::errorInfo"
            }
        }
    }

    set lastUnknownRefCount [array size unkownRef]
    foreach {unkRef usedByTypeList} [array get unkownRef] {
        foreach usedByType $usedByTypeList {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    log::log $options(StrictMode) "Unknown type reference $unkRef in type $usedByType"
                }
                error -
                default {
                    log::log error "Unknown type reference $unkRef in type $usedByType"
                }
            }
        }
    }

    if {$lastUnknownRefCount} {
        switch -exact -- $options(StrictMode) {
            debug -
            warning {
                set ::WS::Utils::targetNs $tmpTargetNs
                ::log::log $options(StrictMode) "Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]"
            }
            error -
            default {
                set ::WS::Utils::targetNs $tmpTargetNs
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
................................................................................
                            [$schemaNode selectNodes -namespaces $nsList w:import] \
    ]
    foreach element $importNodeList {
        if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {







                    log::log $options(StrictMode) "Could not parse:\n [$element asXML]"



















                    log::log $options(StrictMode) "\t error was: $msg"




                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    log::log error "Could not parse:\n [$element asXML]"
                    log::log error "\t error was: $msg"
                    log::log error "\t error info: $errorInfo"

                    log::log error "\t error in: [lindex [info level 0] 0]"
                    log::log error "\t error code: $errorCode"
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::log debug  "Parsing Element types for $xns as $tns"
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
        ::log::log debug "\tprocessing $element"
        if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    log::log $options(StrictMode) "Could not parse:\n [$element asXML]"
                    log::log $options(StrictMode) "\t error was: $msg"
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    log::log error "Could not parse:\n [$element asXML]"
                    log::log error "\t error was: $msg"
                    log::log error "\t error info: $errorInfo"
                    log::log error "\t last element: $::elementName"
                    log::log error "\t error in: [lindex [info level 0] 0]"
                    log::log error "\t error code: $errorCode"

                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::log debug  "Parsing Attribute types for $xns as $tns"
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
        ::log::log debug "\tprocessing $element"
        if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    log::log $options(StrictMode) "Could not parse:\n [$element asXML]"
                    log::log $options(StrictMode) "\t error was: $msg"
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    log::log error "Could not parse:\n [$element asXML]"
                    log::log error "\t error was: $msg"
                    log::log error "\t error info: $errorInfo"
                    log::log error "\t error in: [lindex [info level 0] 0]"
                    log::log error "\t error code: $errorCode"
                    log::log error "\t last element: $::elementName"
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::log debug "Parsing Simple types for $xns as $tns"
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
        ::log::log debug "\tprocessing $element"
        if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    log::log $options(StrictMode) "Could not parse:\n [$element asXML]"
                    log::log $options(StrictMode) "\t error was: $msg"
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    log::log error "Could not parse:\n [$element asXML]"
                    log::log error "\t error was: $msg"
                    log::log error "\t error info: $errorInfo"
                    log::log error "\t error in: [lindex [info level 0] 0]"
                    log::log error "\t error code: $errorCode"
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::log debug  "Parsing Complex types for $xns as $tns"
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
        ::log::log debug "\tprocessing $element"
        if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    log::log $options(StrictMode) "Could not parse:\n [$element asXML]"
                    log::log $options(StrictMode) "\t error was: $msg"
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    log::log error "Could not parse:\n [$element asXML]"
                    log::log error "\t error was: $msg"
                    log::log error "\t error info: $errorInfo"
                    log::log error "\t error in: [lindex [info level 0] 0]"
                    log::log error "\t error code: $errorCode"
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    set ::WS::Utils::targetNs $tmpTargetNs
    ::log::log debug "Leaving :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar"
    ::log::log debug "Target NS is now: $::WS::Utils::targetNs"
    dict set serviceInfo tnsList tns $prevTnsDict
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
proc ::WS::Utils::processImport {mode baseUrl importNode serviceName serviceInfoVar tnsCountVar} {
    upvar 1 $serviceInfoVar serviceInfo
    upvar 1 $tnsCountVar tnsCount
    variable currentSchema
    variable importedXref
    variable options

    ::log::log debug "Entering [info level 0]"
    ##
    ## Get the xml
    ##
    set attrName schemaLocation
    if {![$importNode hasAttribute $attrName]} {
        set attrName namespace
        if {![$importNode hasAttribute $attrName]} {
................................................................................
                -code error \
                -errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
                "Missing Schema Location in '$baseUrl'"
        }
    }
    set urlTail [$importNode getAttribute $attrName]
    set url [::uri::resolve $baseUrl  $urlTail]
    ::log::log debug "Including $url"

    set lastPos [string last / $url]
    set testUrl [string range $url 0 [expr {$lastPos - 1}]]
    if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
        set newUrl $::WS::Utils::redirectArray($testUrl)
        append newUrl [string range $url $lastPos end]
        ::log::log debug "newUrl = $newUrl"
        set url $newUrl
    }

    ::log::log debug "\t Importing {$url}"

    ##
    ## Skip "known" namespace
    ##
    switch -exact -- $url {
        http://schemas.xmlsoap.org/wsdl/ -
        http://schemas.xmlsoap.org/wsdl/soap/ -
................................................................................
        }
    }

    ##
    ## Short-circuit infinite loop on inports
    ##
    if { [info exists importedXref($mode,$serviceName,$url)] } {
        ::log::log debug "$mode,$serviceName,$url was already imported: $importedXref($mode,$serviceName,$url)"
        return
    }
    dict lappend serviceInfo imports $url
    set importedXref($mode,$serviceName,$url) [list $mode $serviceName $tnsCount]
    set urlScheme [dict get [::uri::split $url] scheme]
    ::log::log debug "URL Scheme of {$url} is {$urlScheme}"
    switch -exact -- $urlScheme {
        file {
            ::log::log debug "In file processor -- {$urlTail}"
            set fn [file join  $options(includeDirectory) [string range $urlTail 8 end]]
            set ifd  [open $fn r]
            set xml [read $ifd]
            close $ifd
            ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
        }
        https -
................................................................................
            if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
                return \
                    -code error \
                    -errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
                    "HTTP get of import file failed '$url'"
            } elseif {($ncode == 200) && ![string equal $options(includeDirectory) {}]} {
                set fn [file join  $options(includeDirectory) [file tail $urlTail]]
                ::log::log info "Could not access $url -- using $fn"
                set ifd  [open $fn r]
                set xml [read $ifd]
                close $ifd
            }
            if {[catch {ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar} err]} {
                ::log::log info "Error during processing of XML: $err"
                #puts stderr "error Info: $::errorInfo"
            } else {
                #puts stderr "import successful"
            }
        }
        default {
            return \
................................................................................
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable currentSchema
    variable nsList
    variable unkownRef
    variable defaultType

    ::log::log debug "Entering [info level 0]"

    set isAbstractType false
    set defaultType string
    set typeName $tns:[$node getAttribute name]
    ::log::log debug "Complex Type is $typeName"
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::log debug "\t Abstract type = $isAbstractType"
    }
    #if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
    #    ::log::log debug "\t Type $typeName is already defined -- leaving"
    #    return
    #}
    set partList {}
    set nodeFound 0
................................................................................
    foreach middleNode $middleNodeList {
        set commentNodeList [$middleNode selectNodes -namespaces $nsList xs:annotation]
        if {[llength $commentNodeList]} {
            set commentNode [lindex $commentNodeList 0]
            set comment [string trim [$commentNode asText]]
        }
        set middle [$middleNode localName]
        ::log::log debug "Complex Type is $typeName, middle is $middle"
        #if {$isAbstractType && [string equal $middle attribute]} {
        #    ##
        #    ## Abstract type, so treat like an element
        #    ##
        #    set middle element
        #}

................................................................................
                ##
                continue
            }
            element {
                set nodeFound 1
                if {[$middleNode hasAttribute ref]} {
                    set partType [$middleNode getAttribute ref]
                    ::log::log debug "\t\t has a ref of {$partType}"
                    if {[catch {
                        set refTypeInfo [split $partType {:}]
                        set partName [lindex $refTypeInfo end]
                        set refNS [lindex $refTypeInfo 0]
                        if {[string equal $refNS {}]} {
                            set partType $tns:$partType
                        }
................................................................................
            choice -
            sequence -
            all {
                # set elementList [$middleNode selectNodes -namespaces $nsList xs:element]
                set partMax [$middleNode getAttribute maxOccurs 1]
                set tmp [partList $mode $middleNode $serviceName results $tns $partMax]
                if {[llength $tmp]} {
                    ::log::log debug "\tadding {$tmp} to partslist"
                    set nodeFound 1
                    set partList [concat $partList $tmp]
                } elseif {!$nodeFound} {
                    ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment $comment] $tns
                    return
                }
            # simpleType {
................................................................................
                parseComplexType $mode results $serviceName $middleNode $tns
            }
            simpleContent -
            complexContent {
                foreach child [$middleNode childNodes] {
                    set parent [$child parent]
                    set contentType [$child localName]
                    ::log::log debug "Content Type is {$contentType}"
                    switch -exact -- $contentType {
                        restriction {
                            set nodeFound 1
                            set restriction $child
                            set element [$child selectNodes -namespaces $nsList xs:attribute]
                            set typeInfoList [list baseType [$restriction getAttribute base]]
                            array unset attrArr
................................................................................
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()?}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {
                            ::log::log debug "Calling partList for $contentType of $typeName"
                            if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
                                ::log::log debug "Error in partList {$msg}, errorInfo: $errorInfo"
                            }
                            ::log::log debug "partList for $contentType of $typeName is {$tmp}"
                            if {[llength $tmp]  && ![string equal [lindex $tmp 0] {}]} {
                                set nodeFound 1
                                set partList [concat $partList $tmp]
                            } elseif {[llength $tmp]} {
                                ##
                                ## Found extension, but it is an empty type
                                ##
................................................................................
                if {!$nodeFound} {
                    parseElementalType $mode results $serviceName $node $tns
                    return
                }
            }
        }
    }
    ::log::log debug "at end of foreach {$typeName} with {$partList}"
    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"
        if {[llength $partList]  && ![string equal [lindex $partList 0] {}]} {
            ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
        } else {
................................................................................
    variable defaultType
    variable options
    variable simpleTypes
    upvar 1 $dictVar results

    set partList {}
    set middle [$node localName]
    ::log::log debug "Entering [info level 0] -- for $middle"
    switch -exact -- $middle {
        anyAttribute -
        attribute {
            ##
            ## Do Nothing
            ##
        }
................................................................................
                    set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
                }
            }
        }
        extension {
            set baseName [getQualifiedType $results [$node getAttribute base string] $tns]
            set baseTypeInfo [TypeInfo Client $serviceName $baseName]
            ::log::log debug "\t base name of extension is {$baseName} with typeinfo {$baseTypeInfo}"
            if {[lindex $baseTypeInfo 0]} {
                if {[catch {::WS::Utils::GetServiceTypeDef Client $serviceName $baseName}]} {
                    set baseQuery [format {child::*[attribute::name='%s']} $baseName]
                    set baseNode [$currentSchema selectNodes $baseQuery]
                    #puts "$baseQuery gave {$baseNode}"
                    set baseNodeType [$baseNode localName]
                    switch -exact -- $baseNodeType {
................................................................................
                            ##
                            ## Placed here to shut up tclchecker
                            ##
                        }
                    }
                }
                set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
                ::log::log debug "\t baseInfo is {$baseInfo}"
                if {[llength $baseInfo] == 0} {
                    ::log::log debug "\t Unknown reference '$baseName'"
                    set unkownRef($baseName) 1
                    return;
                }
                catch {set partList [concat $partList [dict get $baseInfo definition]]}
            } else {
                ::log::log debug "\t Simple type"
            }
            foreach elementNode [$node childNodes] {
                set tmp [partList $mode $elementNode $serviceName results $tns]
                if {[llength $tmp]} {
                    set partList [concat $partList $tmp]
                }
            }
        }
        choice -
        sequence -
        all {
            set elementList [$node selectNodes -namespaces $nsList xs:element]
            set elementsFound 0
            ::log::log debug "\telement list is {$elementList}"
            foreach element $elementList {
                ::log::log debug "\t\tprocessing $element ([$element nodeName])"
                set comment {}
                set additional_defininition_elements {}
                if {[catch {
                    set elementsFound 1
                    set attrName name
                    set isRef 0
                    if {![$element hasAttribute name]} {
................................................................................
                    set partName [$element getAttribute $attrName]
                    if {$isRef} {
                        set partType {}
                        set partTypeInfo {}
                        set partType [string trimright [getQualifiedType $results $partName $tns] {?}]
                        set partTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
                        set partName [lindex [split $partName {:}] end]
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partTypeInfo}"
                        if {[dict exists $partTypeInfo definition $partName]} {
                            set partType [dict get $partTypeInfo definition $partName type]
                        }
                        ::log::log debug "\t\t\t part name is {$partName} type is {$partType}"
                    } else {
                        ##
                        ## See if really a complex definition
                        ##
                        if {[$element hasChildNodes]} {
                            set isComplex 0; set isSimple 0
                            foreach child [$element childNodes] {
................................................................................
                    }
                    if {$partMax <= 1} {
                        lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
                    } else {
                        lappend partList $partName [concat [list type [string trimright ${partType} {()?}]() comment $comment] $additional_defininition_elements]
                    }
                } msg]} {
                    ::log::log error "\tError processing {$msg} for [$element asXML]"
                    if {$isRef} {
                        ::log::log error "\t\t Was a reference.  Additionally information is:"
                        ::log::log error "\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}"
                    }
                }
            }
            if {!$elementsFound} {
                set defaultType $options(anyType)
                return
            }
................................................................................
proc ::WS::Utils::parseElementalType {mode dictVar serviceName node tns} {

    upvar 1 $dictVar results
    variable importedXref
    variable nsList
    variable unkownRef

    ::log::log debug "Entering [info level 0]"

    set attributeName name
    if {![$node hasAttribute $attributeName]} {
        set attributeName ref
    }
    set typeName [$node getAttribute $attributeName]
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
        return
    }
    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::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 ""
        if {[$element hasAttribute ref]} {
            set partType [$element getAttribute ref]
            ::log::log debug "\t\t has a ref of {$partType}"
            if {[catch {
                set refTypeInfo [split $partType {:}]
                set partName [lindex $refTypeInfo end]
                set refNS [lindex $refTypeInfo 0]
                if {[string equal $refNS {}]} {
                    set partType $tns:$partType
                }
                ##
                ## Convert the reference to the local tns space
                ##
                set partType  [getQualifiedType $results $partType $tns]
                set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                log::log debug "looking up ref {$partType} got {$refTypeInfo}"
                if {![llength $refTypeInfo]} {
                    error "lookup failed"
                }
                if {[dict exists $refTypeInfo definition]} {
                    set refTypeInfo [dict get $refTypeInfo definition]
                }
                set tmpList [dict keys $refTypeInfo]
................................................................................
                        ## Not a simple element, so point type to type of same name as element
                        ##
                        set partType [getQualifiedType $results $partName $tns]
                    }
                }
            } msg]} {
                lappend unkownRef($partType) $typeName
                log::log debug "Unknown ref {$partType,$typeName} error: {$msg} trace: $::errorInfo"
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                    "Unknown forward type reference {$partType} in {$typeName}"
            }
        } else {
            ::log::log debug "\t\t\t has no ref has {[$element attributes]}"
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
            ::log::log debug "\t\t\ has no ref has [llength $childList]"
            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                set partType [getQualifiedType $results $partName $tns]
                parseElementalType $mode results $serviceName $element $tns
................................................................................
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]
        ::log::log debug "\t\t\t part is {$partName} {$partType} {$partMax}"

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {$partMax <= 1} {
            lappend partList $partName [list type $partType comment {}]
        } else {
................................................................................
#
#
###########################################################################
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable nsList

    ::log::log debug "Entering [info level 0]"

    set typeName [$node getAttribute name]
    if {$typeName in {SAP_VALID_FROM}} {
        set foo 1
    }
    set isList no
    ::log::log debug "Simple Type is $typeName"
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::log debug "\t Type $tns:$typeName is already defined -- leaving"
        return
    }
    #puts "Simple Type is $typeName"
    set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:simpleType/xs:restriction]
    }
................................................................................
    if {[llength $enumList]} {
        lappend partList enumeration $enumList
    }
    if {![dict exists $results types $tns:$typeName]} {
        ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns
        dict set results simpletypes $tns:$typeName $partList
    } else {
        ::log::log debug "\t type already exists as $tns:$typeName"
    }
}



###########################################################################
#
................................................................................
        lassign $typePartsList tmpTns tmpType
        if {[dict exists $serviceInfo tnsList tns $tmpTns]} {
            set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType
        } elseif {[dict exists $serviceInfo types $type]} {
            set result $type
        } else {
            ::log::log error $serviceInfo
            ::log::log error "Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}"
            set result $tns:$type
            return -code error
        }

    }
    return $result
}
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::GenerateTemplateDict {mode serviceName type {arraySize 2}} {
    variable generatedTypes

    ::log::log debug "Entering [info level 0]"
    unset -nocomplain -- generatedTypes

    set result [_generateTemplateDict $mode $serviceName $type $arraySize]

    unset -nocomplain -- generatedTypes
    ::log::log debug "Leaving [info level 0] with {$result}"

    return $result
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
................................................................................
###########################################################################
proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize {xns {}}} {
    variable typeInfo
    variable mutableTypeInfo
    variable options
    variable generatedTypes

    ::log::log debug "Entering [info level 0]"
    set results {}

    ##
    ## Check for circular reference
    ##
    if {[info exists generatedTypes([list $mode $serviceName $type])]} {
        set results {<** Circular Reference **>}
        ::log::log debug "Leaving [info level 0] with {$results}"
        return $results
    } else {
        set generatedTypes([list $mode $serviceName $type]) 1
    }

    set type [string trimright $type {?}]
    # set typeDefInfo [dict get $typeInfo $mode $serviceName $type]
    set typeDefInfo [GetServiceTypeDef $mode $serviceName $type]
    if {![llength $typeDefInfo]} {
      ## We failed to locate the type. try with the last known xns...
      set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type]
    }

    ::log::log debug "\t type def = {$typeDefInfo}"
    set xns [dict get $typeDefInfo xns]

    ##
    ## Check for mutable type
    ##
    if {[info exists mutableTypeInfo([list $mode $serviceName $type])]} {
        set results {<** Mutable Type **>}
        ::log::log debug "Leaving [info level 0] with {$results}"
        return $results
    }

    if {![dict exists $typeDefInfo definition]} {
      ## This is a simple type, simulate a type definition...
      if {![dict exists $typeDefInfo type]} {
        if {[dict exists $typeDefInfo baseType]} {
................................................................................
        } else {
          dict set typeDefInfo type xs:string
        }
      }
      set typeDefInfo [dict create definition [dict create $type $typeDefInfo]]
    }
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::log debug "\t partsList is {$partsList}"
    foreach partName $partsList {
        set partType [string trimright [dict get $typeDefInfo definition $partName type] {?}]
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set isArray [lindex $typeInfoList end]

        ::log::log debug "\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList"
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set msg {Simple non-array}
                ## Is there an enumenration?
................................................................................
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }
        }
    }
    ::log::log debug "Leaving [info level 0] with {$results}"
    return $results
}




###########################################################################
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  02/24/2011  G. Lester    Initial version
#  2.3.10  11/09/2015  H. Oehlmann  Allow only 5 redirects (loop protection)
#
###########################################################################
proc ::WS::Utils::geturl_followRedirects {url args} {
    ::log::log debug "[info level 0]"
    set initialUrl $url
    set finalUrl $url
    array set URI [::uri::split $url] ;# Need host info from here
    for {set loop 1} {$loop <=5} {incr loop} {
        if {[llength $args]} {
            ::log::log info [concat [list ::http::geturl $url] $args]
            set token [eval [list http::geturl $url] $args]
        } else {
            ::log::log info [list ::http::geturl $url]
            set token [::http::geturl $url]
        }
        set ncode [::http::ncode $token]
        ::log::log info "ncode = $ncode"
        if {![string match {30[12378]} $ncode]} {
            ::log::log debug "initialUrl = $initialUrl, finalUrl = $finalUrl"
            if {![string equal $finalUrl {}]} {
                ::log::log debug "Getting initial URL directory"
                set lastPos [string last / $initialUrl]
                set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
                set lastPos [string last / $finalUrl]
                set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
                ::log::log debug "initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir"
                set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
            }
            return $token
        } elseif {![string match {20[1237]} $ncode]} {
            return $token
        }
        # http code announces redirect (3xx)
................................................................................
        array unset meta
        ::http::cleanup $token
        if {[string equal $uri(host) {}]} {
            set uri(host) $URI(host)
        }
        # problem w/ relative versus absolute paths
        set url [eval ::uri::join [array get uri]]
        ::log::log debug "url = $url"
        set finalUrl $url
    }
    # > 5 redirects reached -> exit with error
    return -errorcode [list WS CLIENT REDIRECTLIMIT $url]\
            -code error "http redirect limit exceeded for $url"
}
###########################################################################
................................................................................
#       1  11/08/2015  H.Oehlmann   Initial version
#
###########################################################################
proc ::WS::Utils::geturl_fetchbody {args} {
    set codeOkList {200}
    set codeVar ""
    set bodyAlwaysOk 0
    ::log::log info [concat ::WS::Utils::geturl_fetchbody $args]
    if {[lindex $args 0] eq "-codeok"} {
        set codeOkList [lindex $args 1]
        set args [lrange $args 2 end]
    }
    if {[lindex $args 0] eq "-codevar"} {
        set codeVar [lindex $args 1]
        set args [lrange $args 2 end]
................................................................................
        set ncode [::http::ncode $token]
        set body [::http::data $token]
        ::http::cleanup $token
        if {$bodyAlwaysOk && ![string equal $body ""]
            || -1 != [lsearch $codeOkList $ncode]
        } {
            # >> Fetch ok
            ::log::log debug "\tReceived: $body"
            return $body
        }
        ::log::log debug "\tHTTP error: Wrong code $ncode or no data"
        return -code error -errorcode [list WS CLIENT HTTPERROR $ncode]\
                "HTTP failure code $ncode"
    }
    ::log::log debug "\tHTTP error [array get $token]"
    set error [::http::error $token]
    ::http::cleanup $token
    return -errorcode [list WS CLIENT HTTPERROR $error]\
            -code error "HTTP error: $error"
}







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



|







 







|



|









|


|







|







 







|







 







|






|
|







 







|







 







|







 







|








|










|







|










|




|







 







|








|



|







 







|







 







|




|



|










|







 







|



|

|




|






|






|








|


|


|






|

|







 







|







 







|
|







 







|







 







|









|

|

|







 







|


|





|







 







|







 







|







 







|







 







|




|







 







|







 







|







 







|

|







 







|


|







 







|





|







 







|



|




|







 







|


|







 







|













|



|




|








|







 







|






|





|



|

|

|



|

|

|



|

|

|



|

|

|










|



|










|







 







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





|
|
|
>
|
|











|
|
|




|
|





|
|
|
<
|
|
>











|
|
|
|



|
|





|
|
|
|
|
<











|
|
|
|



<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<





|
|
|
|
|












|
|







 







|







 







|






|



|







 







|





|


|







 







|





|







 







|




|


|







 







|







 







|







 







|







 







|







 







|

|

|







 







|







 







|







 







|







 







|

|





|













|

|







 







|



|







 







|


|







 







|







|






|





|


|


|




|












|







 







|






|

|







 







|







 







|






|

|







 







|







 







|







 







|





|







 







|







|













|







|







 







|







|







 







|







 







|





|


|



|

|






|







 







|







 







|







 







|


|



|





52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
...
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
...
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
....
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
....
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
....
1409
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
1440
1441
1442
1443
....
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
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
....
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
....
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
....
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
....
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
....
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
....
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
....
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
....
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
....
2130
2131
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
2162
2163
2164
....
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
....
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
....
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
....
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
....
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
....
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
....
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
....
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
....
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983

2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016

3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034







3035



















3036




3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
....
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
....
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
....
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
....
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
....
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
....
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
....
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
....
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
....
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
....
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
....
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
....
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
....
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
....
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
....
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
....
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
....
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
....
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
....
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
....
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
....
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
....
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
....
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
....
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
....
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
....
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
....
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
....
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
....
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
....
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
            uplevel 1 [list set $var [lindex $inList $i]]
        }
        return [lrange $inList $numArgs end]
    }
}

package require log

# Emulate the log::logsubst command introduced in log 1.4
if {![llength [info command ::log::logsubst]]} {
    if {![llength [info command ::tailcall]]} {
        proc ::log::logsubst {level text} {
            if {[::log::lvIsSuppressed $level]} {
                return
            }
            ::log::log $level [uplevel 1 [list subst $text]]
        }
    } else {
        proc ::log::logsubst {level text} {
            if {[::log::lvIsSuppressed $level]} {
                return
            }
            tailcall ::log::log $level [uplevel 1 [list subst $text]]
        }
    }
}

package require tdom 0.8
package require struct::set

package provide WS::Utils 2.4.1

namespace eval ::WS {}

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

    if {[llength $args] == 0} {
        ::log::log debug {Return all options}
        return [array get options]
    } elseif {[llength $args] == 1} {
        set opt [lindex $args 0]
        ::log::logsubst debug {One Option {$opt}}
        if {[info exists options($opt)]} {
            return $options($opt)
        } else {
            ::log::logsubst debug {Unkown option {$opt}}
            return \
                -code error \
                -errorcode [list WS CLIENT UNKOPTION $opt] \
                "Unknown option'$opt'"
        }
    } elseif {([llength $args] % 2) == 0} {
        ::log::log debug {Multiple option pairs}
        foreach {opt value} $args {
            if {[info exists options($opt)]} {
                ::log::logsubst debug {Setting Option {$opt} to {$value}}
                set options($opt) $value
            } else {
                ::log::logsubst debug {Unkown option {$opt}}
                return \
                    -code error \
                    -errorcode [list WS CLIENT UNKOPTION $opt] \
                    "Unknown option'$opt'"
            }
        }
    } else {
        ::log::logsubst debug {Bad number of arguments {$args}}
        return \
            -code error \
            -errorcode [list WS CLIENT INVARGCNT $args] \
            "Invalid argument count'$args'"
    }
    return;
}
................................................................................
# 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::logsubst debug {Entering [info level 0]}
    variable typeInfo

    if {![string length $xns]} {
        set xns $service
    }
    if {[llength [split $type {:}]] == 1} {
        set type $xns:$type
................................................................................
#
#
###########################################################################
proc ::WS::Utils::ServiceSimpleTypeDef {mode service type definition {xns {tns1}}} {
    variable simpleTypes
    variable typeInfo

    ::log::logsubst debug {Entering [info level 0]}
    if {![dict exists $definition xns]} {
        set simpleTypes($mode,$service,$type) [concat $definition xns $xns]
    } else {
        set simpleTypes($mode,$service,$type) $definition
    }
    if {[dict exists $typeInfo $mode $service $type]} {
        ::log::logsubst debug {\t Unsetting typeInfo $mode $service $type}
        ::log::logsubst debug {\t Was [dict get $typeInfo $mode $service $type]}
        dict unset typeInfo $mode $service $type
    }
    return;
}

###########################################################################
#
................................................................................
        ::log::log debug "@1"
        set results [dict get $typeInfo $mode $service]
    } else {
        set typeInfoList [TypeInfo $mode $service $type]
        if {[string equal -nocase -length 3 $type {xs:}]} {
            set type [string range $type 3 end]
        }
        ::log::logsubst debug {Type = {$type} typeInfoList = {$typeInfoList}}
        if {[info exists simpleTypes($mode,$service,$type)]} {
            ::log::log debug "@2"
            set results $simpleTypes($mode,$service,$type)
        } elseif {[info exists simpleTypes($type)]} {
            ::log::log debug "@3"
            set results [list type xs:$type xns xs]
        } elseif {[dict exists $typeInfo $mode $service $service:$type]} {
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessImportXml {mode baseUrl xml serviceName serviceInfoVar tnsCountVar} {
    ::log::logsubst debug {Entering [info level 0]}
    upvar 1 $serviceInfoVar serviceInfo
    upvar 1 $tnsCountVar tnsCount
    variable currentSchema
    variable xsltSchemaDom

    set first [string first {<} $xml]
    if {$first > 0} {
................................................................................
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
    variable xsltSchemaDom
    variable nsList
    variable options
    variable includeArr

    ::log::logsubst debug {Entering [info level 0]}

    set includeNodeList [concat \
                            [$rootNode selectNodes -namespaces $nsList descendant::xs:include] \
                            [$rootNode selectNodes -namespaces $nsList descendant::w:include] \
    ]
    set inXml [$rootNode asXML]
    set included 0
    foreach includeNode $includeNodeList {
        ::log::logsubst debug {\t Processing Include [$includeNode asXML]}
        if {[$includeNode hasAttribute schemaLocation]} {
            set urlTail [$includeNode getAttribute schemaLocation]
            set url [::uri::resolve $baseUrl  $urlTail]
        } elseif {[$includeNode hasAttribute location]} {
            set url [$includeNode getAttribute location]
            set urlTail [file tail [dict get [::uri::split $url] path]]
        } else {
            continue
        }
        if {[lsearch -exact $includePath $url] != -1} {
            log::logsubst warning {Include loop detected: [join $includePath { -> }]}
            continue
        } elseif {[info exists includeArr($url)]} {
            continue
        } else {
            set includeArr($url) 1
        }
        incr included
        ::log::logsubst info {\t Including {$url} from base {$baseUrl}}
        switch -exact -- [dict get [::uri::split $url] scheme] {
            file {
                upvar #0 [::uri::geturl $url] token
                set xml $token(data)
                unset token
            }
            https -
            http {
                set ncode -1
                catch {
                    ::log::logsubst info {[list ::http::geturl $url]}
                    set token [::http::geturl $url]
                    ::http::wait $token
                    set ncode [::http::ncode $token]
                    set xml [::http::data $token]
                    ::log::logsubst info {Received Ncode = ($ncode), $xml}
                    ::http::cleanup $token
                }
                if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
                    return \
                        -code error \
                        -errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
                        "HTTP get of import file failed '$url'"
................................................................................
        $parent appendChild [$doc createElement xs:schema schema]
    }
    $schema setAttribute \
        elementFormDefault qualified \
        targetNamespace $targetNamespace

    foreach baseType [lsort -dictionary [array names typeArr]] {
        ::log::logsubst debug {Outputing $baseType}
        $schema appendChild [$doc createElement xs:element elem]
        set name [lindex [split $baseType {:}] end]
        $elem setAttribute name $name
        $elem setAttribute type $baseType
        $schema appendChild [$doc createElement xs:complexType comp]
        $comp setAttribute name $name
        $comp appendChild [$doc createElement xs:sequence seq]
        set baseTypeInfo [dict get $localTypeInfo $baseType definition]
        ::log::logsubst debug {\t parts {$baseTypeInfo}}
        foreach {field tmpTypeInfo} $baseTypeInfo {
            $seq appendChild  [$doc createElement xs:element tmp]
            set tmpType [dict get $tmpTypeInfo type]
            ::log::logsubst debug {Field $field of $tmpType}
            foreach {name value} [getTypeWSDLInfo $mode $serviceName $field $tmpType] {
                $tmp setAttribute $name $value
            }
        }
    }
}

................................................................................

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set xsiNsUrl {http://www.w3.org/2001/XMLSchema-instance}
    ::log::logsubst debug {Entering [info level 0]}
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
    } elseif {[dict exists $typeInfo $mode $serviceName $serviceName:$type]} {
        set typeName $serviceName:$type
    } else {
        ##
        ## Assume this is a simple type
................................................................................
            set results [$node asXML]
        } else {
            set results [$node asText]
        }
        return $results
    }
    set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
    ::log::logsubst debug {\t type def = {$typeDefInfo}}
    set xns [dict get $typeDefInfo xns]
    if {[$node hasAttribute href]} {
        set node [GetReferenceNode $root [$node getAttribute href]]
    }
    ::log::logsubst debug {\t XML of node is [$node asXML]}
    if {[info exists mutableTypeInfo([list $mode $serviceName $typeName])]} {
        set type [(*)[lindex mutableTypeInfo([list $mode $serviceName $type]) 0] $mode $serviceName $typeName $xns $node]
        set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
        ::log::logsubst debug {\t type def replaced with = {$typeDefInfo}}
    }
    set results {}
    #if {$options(parseInAttr)} {
    #    foreach attr [$node attributes] {
    #        if {[llength $attr] == 1} {
    #            dict set results $attr [$node getAttribute $attr]
    #        }
    #    }
    #}
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::logsubst debug {\t partsList is {$partsList}}
    set arrayOverride [expr {$isArray && ([llength $partsList] == 1)}]
    foreach partName $partsList {
        set partType [dict get $typeDefInfo definition $partName type]
        set partType [string trimright $partType {?}]
        if {[dict exists $typeDefInfo definition $partName allowAny] && [dict get $typeDefInfo definition $partName allowAny]} {
            set allowAny 1
        } else {
................................................................................
            set typeInfo $savedTypeInfo
            continue
        }
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set tmpTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
        ::log::logsubst debug {\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList}
        ##
        ## Try for fully qualified name
        ##
        ::log::logsubst debug {Trying #1 [list $node selectNodes $partXns:$partName]}
        if {[catch {llength [set item [$node selectNodes $partXns:$partName]]} len] || ($len == 0)} {
            ::log::logsubst debug {Trying #2 [list $node selectNodes $xns:$partName]}
            if {[catch {llength [set item [$node selectNodes $xns:$partName]]} len] || ($len == 0)} {
                ##
                ## Try for unqualified name
                ##
                ::log::logsubst debug {Trying #3 [list $node selectNodes $partName]}
                if {[catch {llength [set item [$node selectNodes $partName]]} len] || ($len == 0)} {
                    ::log::log debug "Trying #4 -- search of children"
                    set item {}
                    set matchList [list $partXns:$partName  $xns:$partName $partName]
                    foreach childNode [$node childNodes] {
                        set nodeType [$childNode nodeType]
                        ::log::logsubst debug {\t\t Looking at {[$childNode localName],[$childNode nodeName]} ($allowAny,$isArray,$nodeType,$partName)}
                        # From SOAP1.1 Spec:
                        #    Within an array value, element names are not significant
                        # for distinguishing accessors. Elements may have any name.
                        # Here we don't need check the element name, just simple check
                        # it's a element node
                        if {$allowAny  || ($arrayOverride && [string equal $nodeType "ELEMENT_NODE"])} {
                            ::log::logsubst debug {\t\t Found $partName [$childNode asXML]}
                            lappend item $childNode
                        }
                    }
                    if {![string length $item]} {
                        ::log::log debug "\tSkipping"
                        continue
                    }
                } else {
                    ::log::logsubst debug {\t\t Found [llength $item] $partName}
                }
            } else {
                ::log::logsubst debug {\t\t Found [llength $item] $partName}
            }
        } else {
            ::log::logsubst debug {\t\t Found [llength $item] $partName}
        }
        set origItemList $item
        set newItemList {}
        foreach item $origItemList {
            if {[$item hasAttribute href]} {
                set oldXML [$item asXML]
                ::log::logsubst debug {\t\t Replacing: $oldXML}
                set item [GetReferenceNode $root [$item getAttribute href]]
                ::log::logsubst 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]
................................................................................
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }
        }
    }
    ::log::logsubst debug {Leaving ::WS::Utils::convertTypeToDict with $results}
    return $results
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0} {enforceRequired 0}} {
    ::log::logsubst debug {Entering [info level 0]}
    # ::log::logsubst debug {  Parent xml: [$parent asXML]}
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes
    variable currentNs

    if {!$options(UseNS)} {
................................................................................
    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    set type [string trimright $type {?}]
    ::log::logsubst 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 xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns]
            } else {
              error "Simple type cannot be found: $typeName"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::logsubst debug {\titemList is {$itemList} in $xns}
    set entryNs $currentNs
    if {!$forceNs} {
        set currentNs $xns
    }
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        set baseName [lindex [split $itemName {:}] end]
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}}
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        ::log::logsubst debug {Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]}
        if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
            ::log::logsubst debug {Neither {$itemName} nor {$baseName} are in dictionary {$dict}, skipping}
            # If required parameters are being enforced and this field is not optional, throw an error
            if {$enforceRequired && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        } elseif {[dict exists $dict $baseName]} {
            set useName $baseName
................................................................................
        }
        if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
            set itemXns {}
        }
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::logsubst debug {key = {$key} standardAttributes = {$standardAttributes}}
            }
        }
        ::log::logsubst 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::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}}
        # Strip the optional flag off the typeInfoList
        set typeInfoList [lrange $typeInfoList 0 1]
        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 $row]
                        ::log::logsubst debug {<$row> '$dictList'}
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr $valueAttr]} {
                                set resultValue [dict get $row $attr]
                            } elseif {[string match {::*} $attr]} {
                                set baseAttr [string range $attr 2 end]
                                set attrValue [dict get $row $attr]
................................................................................
        #    set dictList [dict keys $dict]
        #    foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
        #        $parent setAttribute $attr [dict get $dict $attr]
        #    }
        #}
    }
    set currentNs $entryNs
    ::log::logsubst 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.
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  03/23/2011  J.Lawson     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type {enforceRequired 0}} {
    ::log::logsubst debug {Entering [info level 0]}
    variable typeInfo
    variable simpleTypes
    variable simpleTypesJson
    variable options
    variable standardAttributes

    set typeInfoList [TypeInfo $mode $service $type]
................................................................................
        set typeInfoList [TypeInfo $mode $service $typeName]
        if {[lindex $typeInfoList 0]} {
            set itemList [dict get $typeInfo $mode $service $typeName definition]
        } else {
            set itemList [list $type {type string}]
        }
    }
    ::log::logsubst debug {\titemList is {$itemList}}
    set fieldList {}
    foreach {itemName itemDef} $itemList {
        lappend fieldList $itemName
        set itemType [dict get $itemDef type]
        ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} itemType = {$itemType}}
        set typeInfoList [TypeInfo $mode $service $itemType 1]
        if {![dict exists $dict $itemName]} {
            if {$enforceRequired && ![lindex $typeInfoList 2]} {
                error "Required field $itemName is missing from response"
            }
            continue
        }
................................................................................

        if {[info exists simpleTypesJson([string trimright $itemType {()?}])]} {
            set yajlType $simpleTypesJson([string trimright $itemType {()?}])
        } else {
            set yajlType "string"
        }

        ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
        set typeInfoList [lrange $typeInfoList 0 1]
        switch $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set resultValue [dict get $dict $itemName]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
    ::log::logsubst debug {Entering [info level 0]}
    # ::log::log debug "  Parent xml: [$parent asXML]"
    variable typeInfo
    variable simpleTypes
    variable options
    variable standardAttributes

    if {$options(valueAttrCompatiblityMode)} {
................................................................................
        } elseif {[info exists simpleTypes($mode,$service,$currentNs:$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$currentNs:$type) xns]
        } else {
          error "Simple type cannot be found: $type"
        }
        set itemList [list $type {type string}]
    }
    ::log::logsubst debug {\titemList is {$itemList}}
    foreach {itemName itemDef} $itemList {
        ::log::logsubst 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 1]
................................................................................
            }
            continue
        }
        set attrList {}
        foreach key [dict keys $itemDef] {
            if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
                lappend attrList $key [dict get $itemDef $key]
                ::log::logsubst debug {key = {$key} standardAttributes = {$standardAttributes}}
            }
        }
        ::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
        set typeInfoList [lrange $typeInfoList 0 1]
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToEncodedType {mode service doc parent dict type} {
    ::log::logsubst debug {Entering [info level 0]}
    variable typeInfo
    variable options


    set typeInfoList [TypeInfo $mode $service $type]
    ::log::logsubst debug {\t typeInfoList = {$typeInfoList}}
    set type [string trimright $type {?}]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        if {[info exists simpleTypes($mode,$service,$type)]} {
          set xns [dict get $simpleTypes($mode,$service,$type) xns]
................................................................................
              set xns [dict get $simpleTypes($mode,$service,$type) xns]
            } else {
              error "Simple type cannot be found: $type"
            }
            set itemList [list $type {type string}]
        }
    }
    ::log::logsubst debug {\titemList is {$itemList} in $xns}
    foreach {itemName itemDef} $itemList {
        set itemType [string trimright [dict get $itemList $itemName type] {?}]
        set typeInfoList [TypeInfo $mode $service $itemType]
        ::log::logsubst debug {\t\t Looking for {$itemName} in {$dict}}
        if {![dict exists $dict $itemName]} {
            ::log::log debug "\t\t Not found, skipping"
            continue
        }
        ::log::logsubst debug {\t\t Type info is {$typeInfoList}}
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                if {[string equal $xns $options(suppressNS)]} {
                    $parent appendChild [$doc createElement $itemName retNode]
................................................................................
#
#
###########################################################################
proc ::WS::Utils::parseDynamicType {mode serviceName node type} {
    variable typeInfo
    variable nsList

    ::log::logsubst debug {Entering [info level 0]}

    foreach child [$node childNodes] {
        ::log::logsubst debug {\t Child $child is [$child nodeName]}
    }

    ##
    ## Get type being defined
    ##
    set schemeNode [$node selectNodes -namespaces $nsList xs:schema]
    set newTypeNode [$node selectNodes -namespaces $nsList  xs:schema/xs:element]
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  08/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::parseScheme {mode baseUrl schemaNode serviceName serviceInfoVar tnsCountVar} {
    ::log::logsubst debug {Entering [info level 0]}

    upvar 1 $tnsCountVar tnsCount
    upvar 1 $serviceInfoVar serviceInfo
    variable currentSchema
    variable nsList
    variable options
    variable unkownRef

    set currentSchema $schemaNode
    set tmpTargetNs $::WS::Utils::targetNs
    foreach attr [$schemaNode attributes] {
        set value {?}
        catch {set value [$schemaNode getAttribute $attr]}
        ::log::logsubst debug {Attribute $attr = $value}
    }
    if {[$schemaNode hasAttribute targetNamespace]} {
        set xns [$schemaNode getAttribute targetNamespace]
        ::log::logsubst debug {In Parse Scheme, found targetNamespace attribute with {$xns}}
        set ::WS::Utils::targetNs $xns
    } else {
        set xns $::WS::Utils::targetNs
    }
    ::log::logsubst debug {@3a {$xns} {[dict get $serviceInfo tnsList url]}}
    if {![dict exists $serviceInfo tnsList url $xns]} {
        set tns [format {tns%d} [incr tnsCount]]
        dict set serviceInfo targetNamespace $tns $xns
        dict set serviceInfo tnsList url $xns $tns
        dict set serviceInfo tnsList tns $tns $tns
    } else {
        set tns [dict get $serviceInfo tnsList url $xns]
    }
    ::log::logsubst debug {@3 TNS count for $xns is $tnsCount {$tns}}

    set prevTnsDict [dict get $serviceInfo tnsList tns]
    dict set serviceInfo tns {}
    foreach itemList [$schemaNode attributes xmlns:*] {
        set ns [lindex $itemList 0]
        set url [$schemaNode getAttribute xmlns:$ns]
        if {[dict exists $serviceInfo tnsList url $url]} {
................................................................................
    ##
    ## Process the scheme in multiple passes to handle forward references and extensions
    ##
    set pass 1
    set lastUnknownRefCount 0
    array unset unkownRef
    while {($pass == 1) || ($lastUnknownRefCount != [array size unkownRef])} {
        ::log::logsubst debug  {Pass $pass over schema}
        incr pass
        set lastUnknownRefCount [array size unkownRef]
        array unset unkownRef

        foreach element [$schemaNode selectNodes -namespaces $nsList xs:import] {
            if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
                ::log::logsubst notice {Import failed due to: {$msg}.  Trace: $::errorInfo}
            }
        }

        foreach element [$schemaNode selectNodes -namespaces $nsList w:import] {
            if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
                ::log::logsubst notice {Import failed due to: {$msg}.  Trace: $::errorInfo}
            }
        }

        ::log::logsubst debug {Parsing Element types for $xns as $tns}
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
            ::log::logsubst debug {\tprocessing $element}
            if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::logsubst notice {Unhandled error: {$msg}.  Trace: $::errorInfo}
            }
        }

        ::log::logsubst debug {Parsing Attribute types for $xns as $tns}
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
            ::log::logsubst debug {\tprocessing $element}
            if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::logsubst notice {Unhandled error: {$msg}.  Trace: $::errorInfo}
            }
        }

        ::log::logsubst debug {Parsing Simple types for $xns as $tns}
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
            ::log::logsubst debug {\tprocessing $element}
            if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::logsubst notice {Unhandled error: {$msg}.  Trace: $::errorInfo}
            }
        }

        ::log::logsubst debug {Parsing Complex types for $xns as $tns}
        foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
            ::log::logsubst debug {\tprocessing $element}
            if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
                ::log::logsubst notice {Unhandled error: {$msg}.  Trace: $::errorInfo}
            }
        }
    }

    set lastUnknownRefCount [array size unkownRef]
    foreach {unkRef usedByTypeList} [array get unkownRef] {
        foreach usedByType $usedByTypeList {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    ::log::logsubst $options(StrictMode) {Unknown type reference $unkRef in type $usedByType}
                }
                error -
                default {
                    ::log::logsubst error {Unknown type reference $unkRef in type $usedByType}
                }
            }
        }
    }

    if {$lastUnknownRefCount} {
        switch -exact -- $options(StrictMode) {
            debug -
            warning {
                set ::WS::Utils::targetNs $tmpTargetNs
                ::log::logsubst $options(StrictMode) {Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]}
            }
            error -
            default {
                set ::WS::Utils::targetNs $tmpTargetNs
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
................................................................................
                            [$schemaNode selectNodes -namespaces $nsList w:import] \
    ]
    foreach element $importNodeList {
        if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    ::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
                    ::log::logsubst $options(StrictMode) {\t error was: $msg}
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    ::log::logsubst error {Could not parse:\n [$element asXML]}
                    ::log::logsubst error {\t error was: $msg}
                    ::log::logsubst error {\t error info: $errorInfo}
                    ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
                    ::log::logsubst error {\t error code: $errorCode}
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::logsubst debug {Parsing Element types for $xns as $tns}
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
        ::log::logsubst debug {\tprocessing $element}
        if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    ::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
                    ::log::logsubst $options(StrictMode) {\t error was: $msg}
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    ::log::logsubst error {Could not parse:\n [$element asXML]}
                    ::log::logsubst error {\t error was: $msg}
                    ::log::logsubst error {\t error info: $errorInfo}
                    ::log::logsubst error {\t last element: $::elementName}
                    ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
                    ::log::logsubst error {\t error code: $errorCode}
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::logsubst debug {Parsing Attribute types for $xns as $tns}
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
        ::log::logsubst debug {\tprocessing $element}
        if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    ::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
                    ::log::logsubst $options(StrictMode) {\t error was: $msg}
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    ::log::logsubst error {Could not parse:\n [$element asXML]}
                    ::log::logsubst error {\t error was: $msg}
                    ::log::logsubst error {\t error info: $errorInfo}

                    ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
                    ::log::logsubst error {\t error code: $errorCode}
                    ::log::logsubst error {\t last element: $::elementName}
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::logsubst debug {Parsing Simple types for $xns as $tns}
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
        ::log::logsubst debug {\tprocessing $element}
        if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {
                    ::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
                    ::log::logsubst $options(StrictMode) {\t error was: $msg}
                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    ::log::logsubst error {Could not parse:\n [$element asXML]}
                    ::log::logsubst error {\t error was: $msg}
                    ::log::logsubst error {\t error info: $errorInfo}
                    ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
                    ::log::logsubst error {\t error code: $errorCode}

                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    ::log::logsubst debug {Parsing Complex types for $xns as $tns}
    foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
        ::log::logsubst debug {\tprocessing $element}
        if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
            switch -exact -- $options(StrictMode) {
                debug -
                warning {







                    ::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}



















                    ::log::logsubst $options(StrictMode) {\t error was: $msg}




                }
                error -
                default {
                    set errorCode $::errorCode
                    set errorInfo $::errorInfo
                    ::log::logsubst error {Could not parse:\n [$element asXML]}
                    ::log::logsubst error {\t error was: $msg}
                    ::log::logsubst error {\t error info: $errorInfo}
                    ::log::logsubst error {\t error in: [lindex [info level 0] 0]}
                    ::log::logsubst error {\t error code: $errorCode}
                    set ::WS::Utils::targetNs $tmpTargetNs
                    return \
                        -code error \
                        -errorcode $errorCode \
                        -errorinfo $errorInfo \
                        $msg
                }
            }
        }
    }

    set ::WS::Utils::targetNs $tmpTargetNs
    ::log::logsubst debug {Leaving :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar}
    ::log::logsubst debug {Target NS is now: $::WS::Utils::targetNs}
    dict set serviceInfo tnsList tns $prevTnsDict
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
#                            that you update this header block. Thanks.
................................................................................
proc ::WS::Utils::processImport {mode baseUrl importNode serviceName serviceInfoVar tnsCountVar} {
    upvar 1 $serviceInfoVar serviceInfo
    upvar 1 $tnsCountVar tnsCount
    variable currentSchema
    variable importedXref
    variable options

    ::log::logsubst debug {Entering [info level 0]}
    ##
    ## Get the xml
    ##
    set attrName schemaLocation
    if {![$importNode hasAttribute $attrName]} {
        set attrName namespace
        if {![$importNode hasAttribute $attrName]} {
................................................................................
                -code error \
                -errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
                "Missing Schema Location in '$baseUrl'"
        }
    }
    set urlTail [$importNode getAttribute $attrName]
    set url [::uri::resolve $baseUrl  $urlTail]
    ::log::logsubst debug {Including $url}

    set lastPos [string last / $url]
    set testUrl [string range $url 0 [expr {$lastPos - 1}]]
    if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
        set newUrl $::WS::Utils::redirectArray($testUrl)
        append newUrl [string range $url $lastPos end]
        ::log::logsubst debug {newUrl = $newUrl}
        set url $newUrl
    }

    ::log::logsubst debug {\t Importing {$url}}

    ##
    ## Skip "known" namespace
    ##
    switch -exact -- $url {
        http://schemas.xmlsoap.org/wsdl/ -
        http://schemas.xmlsoap.org/wsdl/soap/ -
................................................................................
        }
    }

    ##
    ## Short-circuit infinite loop on inports
    ##
    if { [info exists importedXref($mode,$serviceName,$url)] } {
        ::log::logsubst debug {$mode,$serviceName,$url was already imported: $importedXref($mode,$serviceName,$url)}
        return
    }
    dict lappend serviceInfo imports $url
    set importedXref($mode,$serviceName,$url) [list $mode $serviceName $tnsCount]
    set urlScheme [dict get [::uri::split $url] scheme]
    ::log::logsubst debug {URL Scheme of {$url} is {$urlScheme}}
    switch -exact -- $urlScheme {
        file {
            ::log::logsubst debug {In file processor -- {$urlTail}}
            set fn [file join  $options(includeDirectory) [string range $urlTail 8 end]]
            set ifd  [open $fn r]
            set xml [read $ifd]
            close $ifd
            ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
        }
        https -
................................................................................
            if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
                return \
                    -code error \
                    -errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
                    "HTTP get of import file failed '$url'"
            } elseif {($ncode == 200) && ![string equal $options(includeDirectory) {}]} {
                set fn [file join  $options(includeDirectory) [file tail $urlTail]]
                ::log::logsubst info {Could not access $url -- using $fn}
                set ifd  [open $fn r]
                set xml [read $ifd]
                close $ifd
            }
            if {[catch {ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar} err]} {
                ::log::logsubst info {Error during processing of XML: $err}
                #puts stderr "error Info: $::errorInfo"
            } else {
                #puts stderr "import successful"
            }
        }
        default {
            return \
................................................................................
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable currentSchema
    variable nsList
    variable unkownRef
    variable defaultType

    ::log::logsubst debug {Entering [info level 0]}

    set isAbstractType false
    set defaultType string
    set typeName $tns:[$node getAttribute name]
    ::log::logsubst debug {Complex Type is $typeName}
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::logsubst debug {\t Abstract type = $isAbstractType}
    }
    #if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
    #    ::log::log debug "\t Type $typeName is already defined -- leaving"
    #    return
    #}
    set partList {}
    set nodeFound 0
................................................................................
    foreach middleNode $middleNodeList {
        set commentNodeList [$middleNode selectNodes -namespaces $nsList xs:annotation]
        if {[llength $commentNodeList]} {
            set commentNode [lindex $commentNodeList 0]
            set comment [string trim [$commentNode asText]]
        }
        set middle [$middleNode localName]
        ::log::logsubst debug {Complex Type is $typeName, middle is $middle}
        #if {$isAbstractType && [string equal $middle attribute]} {
        #    ##
        #    ## Abstract type, so treat like an element
        #    ##
        #    set middle element
        #}

................................................................................
                ##
                continue
            }
            element {
                set nodeFound 1
                if {[$middleNode hasAttribute ref]} {
                    set partType [$middleNode getAttribute ref]
                    ::log::logsubst debug {\t\t has a ref of {$partType}}
                    if {[catch {
                        set refTypeInfo [split $partType {:}]
                        set partName [lindex $refTypeInfo end]
                        set refNS [lindex $refTypeInfo 0]
                        if {[string equal $refNS {}]} {
                            set partType $tns:$partType
                        }
................................................................................
            choice -
            sequence -
            all {
                # set elementList [$middleNode selectNodes -namespaces $nsList xs:element]
                set partMax [$middleNode getAttribute maxOccurs 1]
                set tmp [partList $mode $middleNode $serviceName results $tns $partMax]
                if {[llength $tmp]} {
                    ::log::logsubst debug {\tadding {$tmp} to partslist}
                    set nodeFound 1
                    set partList [concat $partList $tmp]
                } elseif {!$nodeFound} {
                    ::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment $comment] $tns
                    return
                }
            # simpleType {
................................................................................
                parseComplexType $mode results $serviceName $middleNode $tns
            }
            simpleContent -
            complexContent {
                foreach child [$middleNode childNodes] {
                    set parent [$child parent]
                    set contentType [$child localName]
                    ::log::logsubst debug {Content Type is {$contentType}}
                    switch -exact -- $contentType {
                        restriction {
                            set nodeFound 1
                            set restriction $child
                            set element [$child selectNodes -namespaces $nsList xs:attribute]
                            set typeInfoList [list baseType [$restriction getAttribute base]]
                            array unset attrArr
................................................................................
                            set partName item
                            set partType [getQualifiedType $results $attrArr(arrayType) $tns]
                            set partType [string map {{[]} {()}} $partType]
                            lappend partList $partName [list type [string trimright ${partType} {()?}]() comment $comment allowAny 1]
                            set nodeFound 1
                        }
                        extension {
                            ::log::logsubst debug {Calling partList for $contentType of $typeName}
                            if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
                                ::log::logsubst debug {Error in partList {$msg}, errorInfo: $errorInfo}
                            }
                            ::log::logsubst debug {partList for $contentType of $typeName is {$tmp}}
                            if {[llength $tmp]  && ![string equal [lindex $tmp 0] {}]} {
                                set nodeFound 1
                                set partList [concat $partList $tmp]
                            } elseif {[llength $tmp]} {
                                ##
                                ## Found extension, but it is an empty type
                                ##
................................................................................
                if {!$nodeFound} {
                    parseElementalType $mode results $serviceName $node $tns
                    return
                }
            }
        }
    }
    ::log::logsubst debug {at end of foreach {$typeName} with {$partList}}
    if {[llength $partList] || $isAbstractType} {
        #dict set results types $tns:$typeName $partList
        dict set results types $typeName $partList
        ::log:::log debug  "Defining $typeName"
        if {[llength $partList]  && ![string equal [lindex $partList 0] {}]} {
            ::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
        } else {
................................................................................
    variable defaultType
    variable options
    variable simpleTypes
    upvar 1 $dictVar results

    set partList {}
    set middle [$node localName]
    ::log::logsubst debug {Entering [info level 0] -- for $middle}
    switch -exact -- $middle {
        anyAttribute -
        attribute {
            ##
            ## Do Nothing
            ##
        }
................................................................................
                    set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
                }
            }
        }
        extension {
            set baseName [getQualifiedType $results [$node getAttribute base string] $tns]
            set baseTypeInfo [TypeInfo Client $serviceName $baseName]
            ::log::logsubst debug {\t base name of extension is {$baseName} with typeinfo {$baseTypeInfo}}
            if {[lindex $baseTypeInfo 0]} {
                if {[catch {::WS::Utils::GetServiceTypeDef Client $serviceName $baseName}]} {
                    set baseQuery [format {child::*[attribute::name='%s']} $baseName]
                    set baseNode [$currentSchema selectNodes $baseQuery]
                    #puts "$baseQuery gave {$baseNode}"
                    set baseNodeType [$baseNode localName]
                    switch -exact -- $baseNodeType {
................................................................................
                            ##
                            ## Placed here to shut up tclchecker
                            ##
                        }
                    }
                }
                set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
                ::log::logsubst debug {\t baseInfo is {$baseInfo}}
                if {[llength $baseInfo] == 0} {
                    ::log::logsubst debug {\t Unknown reference '$baseName'}
                    set unkownRef($baseName) 1
                    return;
                }
                catch {set partList [concat $partList [dict get $baseInfo definition]]}
            } else {
                ::log::logsubst debug {\t Simple type}
            }
            foreach elementNode [$node childNodes] {
                set tmp [partList $mode $elementNode $serviceName results $tns]
                if {[llength $tmp]} {
                    set partList [concat $partList $tmp]
                }
            }
        }
        choice -
        sequence -
        all {
            set elementList [$node selectNodes -namespaces $nsList xs:element]
            set elementsFound 0
            ::log::logsubst debug {\telement list is {$elementList}}
            foreach element $elementList {
                ::log::logsubst debug {\t\tprocessing $element ([$element nodeName])}
                set comment {}
                set additional_defininition_elements {}
                if {[catch {
                    set elementsFound 1
                    set attrName name
                    set isRef 0
                    if {![$element hasAttribute name]} {
................................................................................
                    set partName [$element getAttribute $attrName]
                    if {$isRef} {
                        set partType {}
                        set partTypeInfo {}
                        set partType [string trimright [getQualifiedType $results $partName $tns] {?}]
                        set partTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
                        set partName [lindex [split $partName {:}] end]
                        ::log::logsubst debug {\t\t\t part name is {$partName} type is {$partTypeInfo}}
                        if {[dict exists $partTypeInfo definition $partName]} {
                            set partType [dict get $partTypeInfo definition $partName type]
                        }
                        ::log::logsubst debug {\t\t\t part name is {$partName} type is {$partType}}
                    } else {
                        ##
                        ## See if really a complex definition
                        ##
                        if {[$element hasChildNodes]} {
                            set isComplex 0; set isSimple 0
                            foreach child [$element childNodes] {
................................................................................
                    }
                    if {$partMax <= 1} {
                        lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
                    } else {
                        lappend partList $partName [concat [list type [string trimright ${partType} {()?}]() comment $comment] $additional_defininition_elements]
                    }
                } msg]} {
                    ::log::logsubst error {\tError processing {$msg} for [$element asXML]}
                    if {$isRef} {
                        ::log::log error "\t\t Was a reference.  Additionally information is:"
                        ::log::logsubst error {\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}}
                    }
                }
            }
            if {!$elementsFound} {
                set defaultType $options(anyType)
                return
            }
................................................................................
proc ::WS::Utils::parseElementalType {mode dictVar serviceName node tns} {

    upvar 1 $dictVar results
    variable importedXref
    variable nsList
    variable unkownRef

    ::log::logsubst debug {Entering [info level 0]}

    set attributeName name
    if {![$node hasAttribute $attributeName]} {
        set attributeName ref
    }
    set typeName [$node getAttribute $attributeName]
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving}
        return
    }
    set typeType ""
    if {[$node hasAttribute type]} {
        set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
    }
    ::log::logsubst debug {Elemental Type is $typeName}
    set partList {}
    set partType {}
    set isAbstractType false
    if {[$node hasAttribute abstract]} {
        set isAbstractType [$node getAttribute abstract]
        ::log::logsubst debug {\t Abstract type = $isAbstractType}
    }
    set elements [$node selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
    ::log::logsubst debug {\t element list is {$elements} partList {$partList}}
    foreach element $elements {
        set ::elementName [$element asXML]
        ::log::logsubst debug {\t\t Processing element {[$element nodeName]}}
        set elementsFound 1
        set typeAttribute ""
        if {[$element hasAttribute ref]} {
            set partType [$element getAttribute ref]
            ::log::logsubst debug {\t\t has a ref of {$partType}}
            if {[catch {
                set refTypeInfo [split $partType {:}]
                set partName [lindex $refTypeInfo end]
                set refNS [lindex $refTypeInfo 0]
                if {[string equal $refNS {}]} {
                    set partType $tns:$partType
                }
                ##
                ## Convert the reference to the local tns space
                ##
                set partType  [getQualifiedType $results $partType $tns]
                set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
                log::logsubst debug {looking up ref {$partType} got {$refTypeInfo}}
                if {![llength $refTypeInfo]} {
                    error "lookup failed"
                }
                if {[dict exists $refTypeInfo definition]} {
                    set refTypeInfo [dict get $refTypeInfo definition]
                }
                set tmpList [dict keys $refTypeInfo]
................................................................................
                        ## Not a simple element, so point type to type of same name as element
                        ##
                        set partType [getQualifiedType $results $partName $tns]
                    }
                }
            } msg]} {
                lappend unkownRef($partType) $typeName
                log::logsubst debug {Unknown ref {$partType,$typeName} error: {$msg} trace: $::errorInfo}
                return \
                    -code error \
                    -errorcode [list WS $mode UNKREF [list $typeName $partType]] \
                    "Unknown forward type reference {$partType} in {$typeName}"
            }
        } else {
            ::log::logsubst debug {\t\t\t has no ref has {[$element attributes]}}
            set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
            ::log::logsubst debug {\t\t\ has no ref has [llength $childList]}
            if {[llength $childList]} {
                ##
                ## Element defines another element layer
                ##
                set partName [$element getAttribute name]
                set partType [getQualifiedType $results $partName $tns]
                parseElementalType $mode results $serviceName $element $tns
................................................................................
                } else {
                    set partType xs:string
                }

            }
        }
        set partMax [$element getAttribute maxOccurs -1]
        ::log::logsubst debug {\t\t\t part is {$partName} {$partType} {$partMax}}

        if {[string equal $partMax -1]} {
            set partMax [[$element parent] getAttribute maxOccurs -1]
        }
        if {$partMax <= 1} {
            lappend partList $partName [list type $partType comment {}]
        } else {
................................................................................
#
#
###########################################################################
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
    upvar 1 $dictVar results
    variable nsList

    ::log::logsubst debug {Entering [info level 0]}

    set typeName [$node getAttribute name]
    if {$typeName in {SAP_VALID_FROM}} {
        set foo 1
    }
    set isList no
    ::log::logsubst debug {Simple Type is $typeName}
    if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
        ::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving}
        return
    }
    #puts "Simple Type is $typeName"
    set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
    if {[string equal $restrictionNode {}]} {
        set restrictionNode [$node selectNodes -namespaces $nsList xs:simpleType/xs:restriction]
    }
................................................................................
    if {[llength $enumList]} {
        lappend partList enumeration $enumList
    }
    if {![dict exists $results types $tns:$typeName]} {
        ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns
        dict set results simpletypes $tns:$typeName $partList
    } else {
        ::log::logsubst debug {\t type already exists as $tns:$typeName}
    }
}



###########################################################################
#
................................................................................
        lassign $typePartsList tmpTns tmpType
        if {[dict exists $serviceInfo tnsList tns $tmpTns]} {
            set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType
        } elseif {[dict exists $serviceInfo types $type]} {
            set result $type
        } else {
            ::log::log error $serviceInfo
            ::log::logsubst error {Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}}
            set result $tns:$type
            return -code error
        }

    }
    return $result
}
................................................................................
#       1  07/06/2006  G.Lester     Initial version
#
#
###########################################################################
proc ::WS::Utils::GenerateTemplateDict {mode serviceName type {arraySize 2}} {
    variable generatedTypes

    ::log::logsubst debug {Entering [info level 0]}
    unset -nocomplain -- generatedTypes

    set result [_generateTemplateDict $mode $serviceName $type $arraySize]

    unset -nocomplain -- generatedTypes
    ::log::logsubst debug {Leaving [info level 0] with {$result}}

    return $result
}

###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
................................................................................
###########################################################################
proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize {xns {}}} {
    variable typeInfo
    variable mutableTypeInfo
    variable options
    variable generatedTypes

    ::log::logsubst debug {Entering [info level 0]}
    set results {}

    ##
    ## Check for circular reference
    ##
    if {[info exists generatedTypes([list $mode $serviceName $type])]} {
        set results {<** Circular Reference **>}
        ::log::logsubst debug {Leaving [info level 0] with {$results}}
        return $results
    } else {
        set generatedTypes([list $mode $serviceName $type]) 1
    }

    set type [string trimright $type {?}]
    # set typeDefInfo [dict get $typeInfo $mode $serviceName $type]
    set typeDefInfo [GetServiceTypeDef $mode $serviceName $type]
    if {![llength $typeDefInfo]} {
      ## We failed to locate the type. try with the last known xns...
      set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type]
    }

    ::log::logsubst debug {\t type def = {$typeDefInfo}}
    set xns [dict get $typeDefInfo xns]

    ##
    ## Check for mutable type
    ##
    if {[info exists mutableTypeInfo([list $mode $serviceName $type])]} {
        set results {<** Mutable Type **>}
        ::log::logsubst debug {Leaving [info level 0] with {$results}}
        return $results
    }

    if {![dict exists $typeDefInfo definition]} {
      ## This is a simple type, simulate a type definition...
      if {![dict exists $typeDefInfo type]} {
        if {[dict exists $typeDefInfo baseType]} {
................................................................................
        } else {
          dict set typeDefInfo type xs:string
        }
      }
      set typeDefInfo [dict create definition [dict create $type $typeDefInfo]]
    }
    set partsList [dict keys [dict get $typeDefInfo definition]]
    ::log::logsubst debug {\t partsList is {$partsList}}
    foreach partName $partsList {
        set partType [string trimright [dict get $typeDefInfo definition $partName type] {?}]
        set partXns $xns
        catch {set partXns  [dict get $typeInfo $mode $serviceName $partType xns]}
        set typeInfoList [TypeInfo $mode $serviceName $partType]
        set isArray [lindex $typeInfoList end]

        ::log::logsubst debug {\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList}
        switch -exact -- $typeInfoList {
            {0 0} {
                ##
                ## Simple non-array
                ##
                set msg {Simple non-array}
                ## Is there an enumenration?
................................................................................
            default {
                ##
                ## Placed here to shut up tclchecker
                ##
            }
        }
    }
    ::log::logsubst debug {Leaving [info level 0] with {$results}}
    return $results
}




###########################################################################
................................................................................
# Version     Date     Programmer   Comments / Changes / Reasons
# -------  ----------  ----------   -------------------------------------------
#       1  02/24/2011  G. Lester    Initial version
#  2.3.10  11/09/2015  H. Oehlmann  Allow only 5 redirects (loop protection)
#
###########################################################################
proc ::WS::Utils::geturl_followRedirects {url args} {
    ::log::logsubst debug {[info level 0]}
    set initialUrl $url
    set finalUrl $url
    array set URI [::uri::split $url] ;# Need host info from here
    for {set loop 1} {$loop <=5} {incr loop} {
        if {[llength $args]} {
            ::log::logsubst info {[concat [list ::http::geturl $url] $args]}
            set token [eval [list http::geturl $url] $args]
        } else {
            ::log::logsubst info {::http::geturl $url}
            set token [::http::geturl $url]
        }
        set ncode [::http::ncode $token]
        ::log::logsubst info {ncode = $ncode}
        if {![string match {30[12378]} $ncode]} {
            ::log::logsubst debug {initialUrl = $initialUrl, finalUrl = $finalUrl}
            if {![string equal $finalUrl {}]} {
                ::log::log debug "Getting initial URL directory"
                set lastPos [string last / $initialUrl]
                set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
                set lastPos [string last / $finalUrl]
                set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
                ::log::logsubst debug {initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir}
                set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
            }
            return $token
        } elseif {![string match {20[1237]} $ncode]} {
            return $token
        }
        # http code announces redirect (3xx)
................................................................................
        array unset meta
        ::http::cleanup $token
        if {[string equal $uri(host) {}]} {
            set uri(host) $URI(host)
        }
        # problem w/ relative versus absolute paths
        set url [eval ::uri::join [array get uri]]
        ::log::logsubst debug {url = $url}
        set finalUrl $url
    }
    # > 5 redirects reached -> exit with error
    return -errorcode [list WS CLIENT REDIRECTLIMIT $url]\
            -code error "http redirect limit exceeded for $url"
}
###########################################################################
................................................................................
#       1  11/08/2015  H.Oehlmann   Initial version
#
###########################################################################
proc ::WS::Utils::geturl_fetchbody {args} {
    set codeOkList {200}
    set codeVar ""
    set bodyAlwaysOk 0
    ::log::logsubst info {Entering [info level 0]}
    if {[lindex $args 0] eq "-codeok"} {
        set codeOkList [lindex $args 1]
        set args [lrange $args 2 end]
    }
    if {[lindex $args 0] eq "-codevar"} {
        set codeVar [lindex $args 1]
        set args [lrange $args 2 end]
................................................................................
        set ncode [::http::ncode $token]
        set body [::http::data $token]
        ::http::cleanup $token
        if {$bodyAlwaysOk && ![string equal $body ""]
            || -1 != [lsearch $codeOkList $ncode]
        } {
            # >> Fetch ok
            ::log::logsubst debug {\tReceived: $body}
            return $body
        }
        ::log::logsubst debug {\tHTTP error: Wrong code $ncode or no data}
        return -code error -errorcode [list WS CLIENT HTTPERROR $ncode]\
                "HTTP failure code $ncode"
    }
    ::log::logsubst debug {\tHTTP error [array get $token]}
    set error [::http::error $token]
    ::http::cleanup $token
    return -errorcode [list WS CLIENT HTTPERROR $error]\
            -code error "HTTP error: $error"
}

Changes to pkgIndex.tcl.

9
10
11
12
13
14
15
16
17
18
# full path name of this file's directory.

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.5.0 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.0 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]







|


9
10
11
12
13
14
15
16
17
18
# full path name of this file's directory.

package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]]
package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]]
package ifneeded WS::Client 2.5.0 [list source [file join $dir ClientSide.tcl]]
package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]]
package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]]
package ifneeded WS::Utils 2.4.1 [list source [file join $dir Utilities.tcl]]
package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]]
package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]]