home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / TclSOAP / xmlrpc-methods-server.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  2.7 KB  |  99 lines
  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.  
  13. package require base64
  14. package require XMLRPC::Domain
  15. package require rpcvar
  16. namespace import -force rpcvar::*
  17.  
  18. if {[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.  
  26. namespace 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.