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

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

Overview
Comment:Partial fix for [bcdbb594db].

It may be the entire fix -- waiting on feed back.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 94ea895cf9ccfc989169a5d3abadc4d73b36aed6
User & Date: gerald 2015-05-23 17:03:16
Context
2015-05-23 17:12
Switched one of the debug statements back to info. check-in: 11b59f5d29 user: gerald tags: trunk
2015-05-23 17:03
Partial fix for [bcdbb594db].

It may be the entire fix -- waiting on feed back. check-in: 94ea895cf9 user: gerald tags: trunk

2015-05-08 02:38
Fix for [411a2eb59f] -- add double qutoes arround the SOAP Action. check-in: 80934c5bda user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ClientSide.tcl. 

2902
2903
2904
2905
2906
2907
2908

2909






2910
2911
2912
2913
2914
2915
2916

    if {[string equal $inName {}]} {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \
                        $portName $operName]
    } else {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']/w:input[attribute::name='%s']/parent::*} \
                        $portName $operName $inName]
    }

    set operNode [$wsdlNode selectNodes $operQuery]







    set inputMsgNode [$operNode selectNodes {w:input}]
    if {![string equal $inputMsgNode {}]} {
        set inputMsgPath [$inputMsgNode getAttribute message]
        set inputMsg [lindex [split $inputMsgPath {:}] end]
        set inType [messageToType $wsdlNode $serviceName $operName $inputMsg serviceInfo $style]
    }







>

>
>
>
>
>
>








2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923

    if {[string equal $inName {}]} {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \
                        $portName $operName]
    } else {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']/w:input[attribute::name='%s']/parent::*} \
                        $portName $operName $inName]
    }
    ::log:::log debug "\t operNode query is {$operQuery}"
    set operNode [$wsdlNode selectNodes $operQuery]
    if {[string equal $operNode {}] && ![string equal $inName {}]} {
        set operQuery [format {w:portType[attribute::name='%s']/w:operation[attribute::name='%s']} \
                        $portName $operName]
        ::log:::log debug "\t operNode query is {$operQuery}"
        set operNode [$wsdlNode selectNodes $operQuery]
    }

    set inputMsgNode [$operNode selectNodes {w:input}]
    if {![string equal $inputMsgNode {}]} {
        set inputMsgPath [$inputMsgNode getAttribute message]
        set inputMsg [lindex [split $inputMsgPath {:}] end]
        set inType [messageToType $wsdlNode $serviceName $operName $inputMsg serviceInfo $style]
    }

Changes to Utilities.tcl. 

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
...
804
805
806
807
808
809
810



811


812
813
814

815
816
817
818
819






820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
....
2590
2591
2592
2593
2594
2595
2596






2597
2598
2599
2600
2601
2602
2603
....
2664
2665
2666
2667
2668
2669
2670

2671



2672
2673
2674
2675
2676
2677
2678

    }
}

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

package provide WS::Utils 2.3.8

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
................................................................................
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
    variable xsltSchemaDom
    variable nsList
    variable options
    variable includeArr




    set includeNodeList [$rootNode selectNodes -namespaces $nsList descendant::xs:include]


    set inXml [$rootNode asXML]
    set included 0
    foreach includeNode $includeNodeList {

        if {![$includeNode hasAttribute schemaLocation]} {
            continue
        }
        set urlTail [$includeNode getAttribute schemaLocation]
        set url [::uri::resolve $baseUrl  $urlTail]






        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 -
................................................................................
        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"
            }
        }







        ::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"
            }
................................................................................
    }



    ##
    ## Ok, one more pass to report errors
    ##

    foreach element [$schemaNode selectNodes -namespaces $nsList xs:import] {



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







|







 







>
>
>
|
>
>



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









|







 







>
>
>
>
>
>







 







>
|
>
>
>








55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
...
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821


822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
....
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
....
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698

    }
}

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

package provide WS::Utils 2.3.9

namespace eval ::WS {}

namespace eval ::WS::Utils {
    set ::WS::Utils::typeInfo {}
    set ::WS::Utils::currentSchema {}
    array set ::WS::Utils::importedXref {}
................................................................................
###########################################################################
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 debug "\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 -
................................................................................
        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"
            }
................................................................................
    }



    ##
    ## Ok, one more pass to report errors
    ##
    set importNodeList [concat \
                            [$schemaNode selectNodes -namespaces $nsList xs:import] \
                            [$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"
                }

Changes to pkgIndex.tcl. 

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

# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

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

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

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

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







|










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

# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

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

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

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

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

Fossil 2.10 [2da704c5a1] 2019-08-21 12:32:20