silab.tcl

Linux下的MSN聊天程序源码

<tr><td class="sideelt"><a href="http://sourceforge.net/forum/?group_id=25970">Forums</a></td></tr>
<tr><td class="sideelt"><a href="http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tclsoap/tclsoap">Browse CVS</a></td></tr>
<tr><td class="sidehead">Interop</td></tr>
<tr><td class="sideelt"><a href="round1.html">Round 1 Tests</a></td></tr>
<tr><td class="sideelt"><a href="round2base.html">Round 2 Base</a></td></tr>
<tr><td class="sideelt"><a href="round2B.html">Round 2B</a></td></tr>
<tr><td class="sideelt"><a href="round2C.html">Round 2C</a></td></tr>
<tr><td class="sidehead">Support</td></tr>
<tr><td class="sideelt"><a href="http://sourceforge.net/tracker/?aid=385859&group_id=25970&func=browse">Bugs</a></td></tr>
<tr><td class="sideelt"><a href="http://sourceforge.net/tracker/?aid=385860&group_id=25970&func=browse">Support Requests</a></td></tr>
<tr><td class="sideelt"><A href="http://sourceforge.net/tracker/?aid=385861&group_id=25970&func=browse">Patches</a></td></tr>
<tr><td class="sideelt"><A href="http://sourceforge.net/tracker/?aid=385862&group_id=25970&func=browse">Feature Requests</a></td></tr>
    </table>
  </td>
  <td class="body" colspan="2">
  <div class="body">
    }

    puts $logfile "<p>$info</p><hr>"
    flush $logfile
    
    foreach server $servers {
	if {[catch {eval $procname \
			[list [lindex $server 0]] \
                        [list [lindex $server 1]] \
                        [list [lindex $server 2]] \
                        [list [lindex $server 3]] \
                        [lindex $server 4] \
                    } msg ]} {
	    puts $logfile "<font color=\"red\">\
                    <h3>An Error occurred processing [lindex $server 0]</h3>\
		    <p>$msg</p></font>"
	}
	flush $logfile
    }

    puts $logfile {
</div>
</td></tr>
<tr class="footer">
<td class="footer" colspan="3">
    }
    puts $logfile "Last Updated: [clock format [clock seconds]]"
    puts $logfile {
</td></tr>

    </table>
  </body>
</html>
    }

    close $logfile
}
    
# -------------------------------------------------------------------------
# Description:
#  Setup and run the base SOAP Interop Lab Client tests.
#
proc proposalA {toolkit where action xmlns args} {
    global logfile

    set soapinterop::uri $xmlns
    set soapinterop::action $action
    eval soapinterop::create:base [list $where] $args

    puts $logfile "<h2><a name=\"$toolkit\">$toolkit $where</a></h2>\n<table>\n"

    perform $toolkit soapinterop::validate.echoVoid
    perform $toolkit soapinterop::validate.echoDate
    perform $toolkit soapinterop::validate.echoBase64
    perform $toolkit soapinterop::validate.echoInteger
    perform $toolkit soapinterop::validate.echoFloat
    perform $toolkit soapinterop::validate.echoString
    perform $toolkit soapinterop::validate.echoIntegerArray
    perform $toolkit soapinterop::validate.echoFloatArray
    perform $toolkit soapinterop::validate.echoStringArray
    perform $toolkit soapinterop::validate.echoStruct
    perform $toolkit soapinterop::validate.echoStructArray

    puts $logfile "</table><hr>\n\n"
    return {}
}

# -------------------------------------------------------------------------
# Description:
#  Setup and run the base SOAP Interop Lab Client proposal B tests.
#
proc proposalB {toolkit where action xmlns args} {
    global logfile

    set soapinterop::uri $xmlns
    set soapinterop::action $action
    eval soapinterop::create:proposalB [list $where] $args

    puts $logfile "<h2><a name=\"$toolkit\">$toolkit $where</a></h2>\n<table>\n"

    perform $toolkit soapinterop::validate.echoStructAsSimpleTypes
    perform $toolkit soapinterop::validate.echoSimpleTypesAsStruct
    perform $toolkit soapinterop::validate.echoNestedArray
    perform $toolkit soapinterop::validate.echoNestedStruct
    perform $toolkit soapinterop::validate.echo2DStringArray

    puts $logfile "</table><hr>\n\n"
    return {}
}

# -------------------------------------------------------------------------
# Description:
#  Setup and run the Round 2 Proposal C tests (found in soapinteropC.tcl)
#
proc proposalC {toolkit where action xmlns args} {
    global logfile

    eval SOAP::create soapinterop::echoVoid \
        -name echoVoid \
	-proxy  [list $where] \
        -uri    [list $xmlns] \
        -action [list $action] $args

    puts $logfile "<h2><a name=\"$toolkit\">$toolkit $where</a></h2>\n<table>\n"

    perform $toolkit soapinterop::validate.emsr:A echoVoid propc
    perform $toolkit soapinterop::validate.emsr:B echoVoid propc
    perform $toolkit soapinterop::validate.emsr:C echoVoid propc
    perform $toolkit soapinterop::validate.emsr:D echoVoid propc
    perform $toolkit soapinterop::validate.emsr:E echoVoid propc
    perform $toolkit soapinterop::validate.emsr:F echoVoid propc
    perform $toolkit soapinterop::validate.emtr:A echoVoid propc
    perform $toolkit soapinterop::validate.emtr:B echoVoid propc
    perform $toolkit soapinterop::validate.emtr:C echoVoid propc
    perform $toolkit soapinterop::validate.emtr:D echoVoid propc
    perform $toolkit soapinterop::validate.emtr:E echoVoid propc
    perform $toolkit soapinterop::validate.emtr:F echoVoid propc

    puts $logfile "</table><hr>\n\n"
    return {}
}
    
# -------------------------------------------------------------------------
# Description:
#  Perform a SOAP call. Capture the request and reply XML packets and save
#  to unique files under `logdir'. Appends a suitable log message to the
#  `logfile'
#
proc perform {toolkit procname {methodname {}} {prefix dump}} {
    global logfile
    global logdir
    global logcount

    set name [lindex [split $procname .] end]
    if {$methodname != {}} {set name $methodname}
    set failed [catch [list $procname] msg]
    if {$failed} {
	set msg [string map {< &lt; > &gt; & &amp;} $msg]
	set msg "<font color=\"red\">$msg</font>"
    } else {
	set msg ok
    }
    
    puts $logfile "<tr><td>$name</td><td>$msg</td>"

    if {$logdir != {}} {
        set request [file join $logdir "${prefix}${logcount}.xml"]
        incr logcount
        set reply   [file join $logdir "${prefix}${logcount}.xml"]
        incr logcount

        set err [catch {SOAP::dump -req soapinterop::$name} xml]
        set f [open $request w]
        puts -nonewline $f $xml
        close $f
        
        catch {SOAP::dump soapinterop::$name} xml
        set f [open $reply w]
        puts -nonewline $f $xml
        close $f

        puts $logfile "<td><a href=\"[file tail $request]\">request</a></td>\
	               <td><a href=\"[file tail $reply]\">reply</a></td></tr>"
    }
}

# Should we go ahead and run this...
if {!$::tcl_interactive} {
    set logdir   [file join [pwd] interop-results]
    silab:round1
    silab:round2
    silab:round2B
    silab:round2C
}