Forum OpenACS Q&A: Re: Tcl Web Service

Collapse
7: Re: Tcl Web Service (response to 6)
Posted by Michal Hanckowiak on
more compact version of the code above...

if tclws_definition proc is defined somewhere:
------------------------------------------
proc tclws_eval args {uplevel $args}
proc tclws_definition code {
set p1 [ad_conn url]
set p2 [ad_conn path_info]
set p3 [string range $p1 0 end-[string len $p2]]
set p4 [lindex [split $p3 /] end]
set service $p4
set prefix $p3
set host "[ad_host][ad_port]"
set interpName tclws_[ad_conn package_key]_$service
if {![interp exists $interpName]} {
interp create $interpName
$interpName alias x tclws_eval
$interpName alias ns_return ns_return
$interpName eval set service $service
$interpName eval set prefix $prefix
$interpName eval set host $host
$interpName eval {
proc log {x y} {x ns_log $x $y}
namespace eval log {}
proc log::log {x y} {x ns_log $x $y}
package re WS::Server
package re WS::AOLserver
}
$interpName eval $code
}
$interpName eval {
set reqType [x ad_conn path_info]
if {$reqType=="/"||$reqType==""} {set reqType "/doc"}
switch -exact -- $reqType {
/doc {
WS::Server::generateInfo $service nosock
log notice "WS::Server::generateInfo $service nosock"
}
/wsdl {
WS::Server::generateWsdl $service nosock
log notice "WS::Server::generateWsdl $service nosock"
}
/op {
upvar #0 Httpdnosock data
set data(ipaddr) [x ad_conn peeraddr]
set data(headerlist) [x ns_set array [x ad_conn headers]]
set data(query) [x ad_conn content]
WS::Server::callOperation $service nosock
log notice "WS::Server::callOperation $service nosock"
}
}
}
}
------------------------------------------

then .vuh file becomes very simple:
------------------------------------------
tclws_definition {
::WS::Server::Service -mode aolserver \
-prefix $prefix -service $service -host $host \
-description {oacs + tclws example}

::WS::Server::ServiceProc $service {razyDwa {type int()}} {
par1 {type int() comment {ciag liczb int}}
} {mnozy elementy ciagu razy 2} {
set w {}
foreach e $par1 {lappend w [expr {$e*2}]}
return [list razyDwaResult $w]
}

::WS::Server::ServiceProc $service {razyTrzy {type int()}} {
par1 {type int() comment {ciag liczb int}}
} {mnozy elementy ciagu razy 3} {
set w {}
foreach e $par1 {lappend w [expr {$e*3}]}
return [list razyTrzyResult $w]
}

}
------------------------------------------