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 / tclserver.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  1.6 KB  |  49 lines
  1. # tclserver.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
  2. #
  3. # Provide webservices from tclhttpd using the SOAP::CGI package.
  4. # This is equivalent to the `rpc' script in cgi-bin that provides the same
  5. # webservices via CGI.
  6. #
  7. # TODO:
  8. #  This should be optimised somewhat. At the moment we are sourceing the
  9. #  service implementation files each time a request arrives ala. CGI. However,
  10. #  running under tclhttpd we are using the _same_ process each time. So 
  11. #  we should source the implementations _one_ time and then simply call the 
  12. #  procedures in the correct namespace.
  13. #  This might need some refactoring in SOAP-CGI.tcl.
  14. #
  15. #
  16. # $Id: tclserver.tcl,v 1.2 2001/08/05 22:54:25 patthoyts Exp $
  17.  
  18. package require SOAP::CGI
  19.  
  20. # Set to the cgi-bin or wherever.
  21. set root [file join $::env(HOME) lib tcl tclsoap cgi-bin]
  22.  
  23. set SOAP::CGI::soapdir       [file join $root soap]
  24. set SOAP::CGI::soapmapfile   [file join $root soapmap.dat]
  25. set SOAP::CGI::xmlrpcdir     [file join $root soap]
  26. set SOAP::CGI::xmlrpcmapfile [file join $root xmlrpcmap.dat]
  27. catch {unset SOAP::CGI::logfile}
  28.  
  29. Url_PrefixInstall /RPC rpc_handler
  30.  
  31. proc rpc_handler {sock args} {
  32.     upvar \#0 Httpd$sock data
  33.     
  34.     if {[catch {
  35.     set query $data(query)
  36.     set doc [dom::DOMImplementation parse $query]
  37.     
  38.     if {[SOAP::CGI::selectNode $doc "/Envelope"] != {}} {
  39.         set result [SOAP::CGI::soap_invocation $doc]
  40.     } elseif {[SOAP::CGI::selectNode $doc "/methodCall"] != {}} {
  41.         set result [SOAP::CGI::xmlrpc_invocation $doc]
  42.     }
  43.     
  44.     Httpd_ReturnData $sock text/xml $result 200
  45.     } err]} {
  46.     Httpd_ReturnData $sock text/xml $err 500
  47.     }
  48. }
  49.