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 / soap-methods-server.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  3.5 KB  |  117 lines
  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.3 2001/08/01 23:47:06 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. #
  21. package require SOAP::Domain
  22. package require rpcvar
  23. namespace import -force rpcvar::*
  24.  
  25. SOAP::Domain::register -prefix /soap -namespace tclsoap::Test
  26.  
  27. namespace eval tclsoap::Test {}
  28.  
  29. # -------------------------------------------------------------------------
  30. # base64 - convert the input string parameter to a base64 encoded string
  31. #
  32. proc tclsoap::Test::/base64 {text} {
  33.     package require base64
  34.     return [rpcvar base64 [base64::encode $text]]
  35. }
  36.  
  37. # -------------------------------------------------------------------------
  38. # time - return the servers idea of the time
  39. #
  40. proc tclsoap::Test::/time {} {
  41.     return [clock format [clock seconds]]
  42. }
  43.  
  44. # -------------------------------------------------------------------------
  45. # rcsid - return the RCS version string for this package
  46. #
  47. proc tclsoap::Test::/rcsid {} {
  48.     return ${::SOAP::Domain::rcs_id}
  49. }
  50.  
  51. # -------------------------------------------------------------------------
  52. # square - test validation of numerical methods.
  53. #
  54. proc tclsoap::Test::/square {num} {
  55.     if { [catch {expr $num + 0}] } {
  56.         error "parameter num must be a number"
  57.     }
  58.     return [expr $num * $num]
  59. }
  60.  
  61. # -------------------------------------------------------------------------
  62. # sum - test two parameter method
  63. #
  64. proc tclsoap::Test::/sum {lhs rhs} {
  65.     return [expr $lhs + $rhs]
  66. }
  67.  
  68. # -------------------------------------------------------------------------
  69. # sort - sort a list
  70. #
  71. proc tclsoap::Test::/sort {myArray} {
  72.     return [rpcvar "array" [lsort $myArray]]
  73. }
  74.  
  75. # -------------------------------------------------------------------------
  76. # platform - return a structure.
  77. #
  78. proc tclsoap::Test::/platform {} {
  79.     return [rpcvar struct ::tcl_platform]
  80. }
  81.  
  82. # -------------------------------------------------------------------------
  83. # xml - return some XML data. Just to show it's not a problem.
  84. #
  85. proc tclsoap::Test::/xml {} {
  86.     set xml {<?xml version="1.0" ?>
  87. <memos>
  88.    <memo>
  89.       <subject>test memo one</subject>
  90.       <body>The body of the memo.</body>
  91.    </memo>
  92.    <memo>
  93.       <subject>test memo two</subject>
  94.       <body>Memo body with specials: " & ' and <></body>
  95.    </memo>
  96. </memos>
  97. }
  98.     return $xml
  99. }
  100.  
  101. # -------------------------------------------------------------------------
  102. # Test out a COM calling extension.
  103. #
  104. proc tclsoap::Test::/WiRECameras/get_Count {} {
  105.     package require Renicam
  106.     return [renicam count]
  107. }
  108.  
  109. # -------------------------------------------------------------------------
  110.  
  111. proc tclsoap::Test::/WiRECameras/Add {} {
  112.     package require Renicam
  113.     return [renicam add]
  114. }
  115.  
  116. # -------------------------------------------------------------------------
  117.