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