1# -------------------------------------------------------------------------
2# Examples of XML-RPC methods for use with XMLRPC::Domain under the tclhttpd
3# web sever.
4# -------------------------------------------------------------------------
5#
6
7# Load the XMLRPC URL domain handler into the web server and register it under
8# the /rpc URL. All methods need to be defined in the zsplat::RPC
9# namespace and begin with /. Thus my /base64 procedure will be called
10# via the URL http://localhost:8015/soap/base64
11#
12
13package require base64
14package require XMLRPC::Domain
15package require rpcvar
16namespace import -force rpcvar::*
17
18if {[catch {
19    XMLRPC::Domain::register -prefix /rpc -namespace tclsoapTest1
20} msg]} {
21    if { $msg != "URL prefix \"/rpc\" already registered"} {
22	puts "Warning: $msg"
23    }
24}
25
26namespace eval tclsoapTest1 {
27
28
29    # --------------------------------------------------------------------
30    # base64 - convert the input string parameter to a base64 encoded string
31    #
32    proc /base64 {text} {
33	return [rpcvar base64 [base64::encode $text]]
34    }
35
36    # --------------------------------------------------------------------
37    # time - return the servers idea of the time in iso8601 format
38    #
39    proc /time {} {
40	set result [clock format [clock seconds] -format {%Y%m%dT%H:%M:%S}]
41	set result [rpcvar dateTime.iso8601 $result]
42	return $result
43    }
44
45    # --------------------------------------------------------------------
46    # rcsid - return the RCS version string for this package
47    #
48    proc /rcsid {} {
49	return "${::XMLRPC::Domain::rcs_id}"
50    }
51
52    # --------------------------------------------------------------------
53    # square - test validation of numerical methods.
54    #
55    proc /square {num} {
56	if { [catch {expr $num + 0}] } {
57	    error "parameter num must be a number"
58	}
59	return [expr $num * $num]
60    }
61
62    # --------------------------------------------------------------------
63    # sort - sort a list
64    #
65    proc /sort {aList} {
66	return [rpcvar array [lsort $aList]]
67    }
68
69    # --------------------------------------------------------------------
70    # struct - generate a XML-RPC struct type
71    #
72    proc /platform {} {
73	return [rpcvar struct ::tcl_platform]
74    }
75
76    # --------------------------------------------------------------------
77    # Test out a COM calling extension.
78    #
79    proc /WiRECameras/get_Count {} {
80	package require Renicam
81	return [renicam count]
82    }
83
84    # --------------------------------------------------------------------
85
86    proc /WiRECameras/Add {} {
87	package require Renicam
88	return [renicam add]
89    }
90
91    # ---------------------------------------------------------------------
92}
93
94# -------------------------------------------------------------------------
95#
96# Local variables:
97# mode: tcl
98# End:
99