1# soap-methods-server.tcl
2#                   - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
3#
4# Provides examples of SOAP methods for use with SOAP::Domain under the
5# tclhttpd web sever.
6#
7# -------------------------------------------------------------------------
8# This software is distributed in the hope that it will be useful, but
9# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10# or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
11# for more details.
12# -------------------------------------------------------------------------
13#
14# @(#)$Id: soap-methods-server.tcl,v 1.4 2002/02/27 21:29:14 patthoyts Exp $
15
16# Load the SOAP URL domain handler into the web server and register it under
17# the /soap URL. All methods need to be defined in the SOAP::Domain
18# namespace and begin with /. Thus my /base64 procedure will be called
19# via the URL http://localhost:8015/soap/base64
20#
21package require SOAP::Domain
22package require rpcvar
23package require base64
24
25SOAP::Domain::register          \
26    -prefix    /soap            \
27    -namespace urn:tclsoap:Test \
28    -uri       urn:tclsoap:Test
29
30namespace eval urn:tclsoap:Test {
31
32    namespace import -force ::rpcvar::*
33
34    SOAP::export base64 time rcsid square sum sort platform xml
35
36}
37
38# -------------------------------------------------------------------------
39# base64 - convert the input string parameter to a base64 encoded string
40#
41proc urn:tclsoap:Test::base64 {text} {
42    return [rpcvar base64 [base64::encode $text]]
43}
44
45# -------------------------------------------------------------------------
46# time - return the servers idea of the time
47#
48proc urn:tclsoap:Test::time {} {
49    return [clock format [clock seconds]]
50}
51
52# -------------------------------------------------------------------------
53# rcsid - return the RCS version string for this package
54#
55proc urn:tclsoap:Test::rcsid {} {
56    return ${::SOAP::Domain::rcs_id}
57}
58
59# -------------------------------------------------------------------------
60# square - test validation of numerical methods.
61#
62proc urn:tclsoap:Test::square {num} {
63    if { [catch {expr $num + 0}] } {
64        return -code error -errorcode Client "parameter num must be a number"
65    }
66    return [expr {$num * $num}]
67}
68
69# -------------------------------------------------------------------------
70# sum - test two parameter method
71#
72proc urn:tclsoap:Test::sum {lhs rhs} {
73    return [expr {$lhs + $rhs}]
74}
75
76# -------------------------------------------------------------------------
77# sort - sort a list
78#
79proc urn:tclsoap:Test::sort {myArray} {
80    return [rpcvar "array" [lsort $myArray]]
81}
82
83# -------------------------------------------------------------------------
84# platform - return a structure.
85#
86proc urn:tclsoap:Test::platform {} {
87    return [rpcvar struct ::tcl_platform]
88}
89
90# -------------------------------------------------------------------------
91# xml - return some XML data. Just to show it's not a problem.
92#
93proc urn:tclsoap:Test::xml {} {
94    set xml {<?xml version="1.0" ?>
95<memos>
96   <memo>
97      <subject>test memo one</subject>
98      <body>The body of the memo.</body>
99   </memo>
100   <memo>
101      <subject>test memo two</subject>
102      <body>Memo body with specials: &quot; &amp; &apos; and &lt;&gt;</body>
103   </memo>
104</memos>
105}
106    return $xml
107}
108