1 pjaol 1.1 #maintain a list of
  2           #soap lists
  3           
  4           package require tdom
  5           global _soapdoc
  6           
  7           proc soap.init {} {
  8               set soap(startup) [clock format [clock seconds]]
  9               nsv_array set _soapLists [array get soap]
 10           }
 11           
 12           proc soap.reload {} {
 13               ns_eval source /home/pjaol/work/tcl_lib/nsdtcl/nssoap.tcl
 14           }
 15           
 16           proc soap.addProc { procName } {
 17               nsv_set _soapLists proc,$procName 1
 18           }
 19           
 20           
 21           proc soap.isSoapProc { procName } {
 22 pjaol 1.1     catch {
 23           	return nsv_get _soapList proc,$procName
 24               } err
 25               return 0
 26           }
 27           
 28           
 29           proc soap.execute { procName {args} } {
 30           
 31               set re ""
 32               soap.createEnvelope
 33               soap.createBody $procName
 34           
 35               catch {
 36           	set results [eval "$procName $args"]
 37           	set re [soap.createResponse $procName $results]
 38               } err
 39               
 40               if {![string length $re] } {
 41           	soap.createFault $procName $err soap:Server ; #internal error code
 42               }
 43 pjaol 1.1     global _soapdoc
 44               return [$_soapdoc asXML]
 45           }
 46           
 47           
 48           proc soap.createFault { procName err errorCode} {
 49               global _soapdoc
 50               set root [$_soapdoc documentElement]
 51               set soapbody [$root getElementsByTagName soap:Body]
 52           
 53               set fault [$_soapdoc createElement soap:Fault]
 54           
 55               #written as text, as not dynamic
 56               set faultCode "<faultcode>$errorCode</faultcode>"
 57               set faultString "<faultstring>[ns_quotehtml $err]</faultstring>"
 58           
 59               $fault appendXML $faultCode
 60               $fault appendXML $faultString
 61               $soapbody appendChild $fault
 62           }
 63           
 64 pjaol 1.1 proc soap.createEnvelope {} {
 65               global _soapdoc
 66               dom createDocumentNS http://www.w3.org/2001/12/soap-envelope soap:Envelope _soapdoc
 67           }
 68           
 69           
 70           proc soap.createResponse { procName {results} } {
 71           
 72               global _soapdoc
 73               
 74               set root [$_soapdoc documentElement]
 75               set soapbody [$root getElementsByTagName soap:Body] ;#possible bug in tdom,
 76           	                                                 #xpath query returns null if body is empty
 77               set response [$_soapdoc createElement "m:${procName}Response"]
 78               set responseNode [$soapbody appendChild $response]
 79               
 80               #screwie results
 81               foreach i $results {
 82           	set child [$_soapdoc createElement "string"]
 83           	$child setAttribute "xsi:type" "xsd:string"
 84           	$child appendFromList [list "#text" [ns_quotehtml $i]]
 85 pjaol 1.1 	$responseNode appendChild $child
 86               }
 87               return 1
 88           }
 89           
 90           proc soap.createBody { procName } {
 91           
 92               global _soapdoc
 93               
 94               set root [$_soapdoc documentElement]
 95               
 96               set body [$_soapdoc createElement "soap:Body"]
 97               set bodyNode [$root appendChild $body]
 98           }
 99           
100           soap.init