1# tclsoap-Test.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com> 2# 3# Sample SOAP methods for testing out the TclSOAP package. 4# 5# ------------------------------------------------------------------------- 6# This software is distributed in the hope that it will be useful, but 7# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 8# or FITNESS FOR A PARTICULAR PURPOSE. See the accompanying file `LICENSE' 9# for more details. 10# ------------------------------------------------------------------------- 11# 12# @(#)$Id: tclsoap-Test.tcl,v 1.2 2003/01/26 01:57:33 patthoyts Exp $ 13 14package require SOAP 15package require XMLRPC 16package require rpcvar 17namespace import -force rpcvar::* 18 19namespace eval urn:tclsoap:Test { 20 21 SOAP::export time square sum platform printenv printenv_names mistake 22 23 # --------------------------------------------------------------------- 24 # Sample SOAP method returning a single string value that is the servers 25 # current time in iso8601 point in time format. 26 proc time {} { 27 set r [rpcvar timeInstant \ 28 [clock format [clock seconds] -format {%Y%m%dT%H%M%S} \ 29 -gmt true]] 30 return $r 31 } 32 33 # --------------------------------------------------------------------- 34 # Sample SOAP method taking a single numeric parameter and returning 35 # the square of the value. 36 proc square {num} { 37 if {[catch {expr $num + 0.0} num]} { 38 error "invalid arguments: \"num\" must be a number" {} CLIENT 39 } 40 return [expr $num * $num] 41 } 42 43 # --------------------------------------------------------------------- 44 # Sample SOAP method taking a single numeric parameter and returning 45 # the sum of two values. 46 proc sum {lhs rhs} { 47 if {[catch {expr $lhs + $rhs} r]} { 48 error "invalid arguments: both parameters must be numeric" \ 49 {} CLIENT 50 } 51 return $r 52 } 53 54 # --------------------------------------------------------------------- 55 # Method returning a struct type. 56 proc platform {} { 57 return [rpcvar struct ::tcl_platform] 58 } 59 60 # --------------------------------------------------------------------- 61 # Sample SOAP method returning an array of structs. The structs are 62 # struct { 63 # string name; 64 # any value; 65 # } 66 proc printenv {} { 67 set r {} 68 foreach {name value} [array get ::env] { 69 lappend r [rpcvar "struct" [list "name" $name "value" $value]] 70 } 71 set result [rpcvar "array" $r] 72 return $result 73 } 74 75 # --------------------------------------------------------------------- 76 # just return an array of strings. 77 proc printenv_names {} { 78 set result [array names ::env] 79 set result [rpcvar "array(string)" $result] 80 return $result 81 } 82 83 # --------------------------------------------------------------------- 84 # Sample SOAP method returning an error 85 proc mistake {} { 86 error "It's a mistake!" {} SERVER 87 } 88 89} 90 91# ------------------------------------------------------------------------- 92 93# Setup XML-RPC versions of these methods by linking a suitable XML-RPC 94# name to the SOAP namespace and exporting the new name to XML-RPC. 95# 96foreach name {time square sum platform printenv printenv_names mistake} { 97 set newname tclsoap.$name 98 interp alias {} $newname {} urn:tclsoap:Test::$name 99 XMLRPC::export $newname 100} 101 102# ------------------------------------------------------------------------- 103 104# 105# Local variables: 106# mode: tcl 107# End: 108