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: " & ' and <></body> 103 </memo> 104</memos> 105} 106 return $xml 107} 108