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