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
18package require SOAP::CGI
19
20# Set to the cgi-bin or wherever.
21set root [file join $::env(HOME) lib tcl tclsoap cgi-bin]
22
23set SOAP::CGI::soapdir       [file join $root soap]
24set SOAP::CGI::soapmapfile   [file join $root soapmap.dat]
25set SOAP::CGI::xmlrpcdir     [file join $root soap]
26set SOAP::CGI::xmlrpcmapfile [file join $root xmlrpcmap.dat]
27catch {unset SOAP::CGI::logfile}
28
29Url_PrefixInstall /RPC rpc_handler
30
31proc 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