add Pelican
r3108 | jgn | 2011-04-20 12:29:55 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
committed by
Douglas Clowes
parent
1fa3d21486
commit
22b22ffa25
@@ -0,0 +1,169 @@
|
||||
#------------------------------------------------------
|
||||
# This is SICS HM driver code for the CCDWWW CCD camera
|
||||
# WWW server as used at SINQ. It uses, of course, the
|
||||
# scriptcontext asynchronous I/O system
|
||||
#
|
||||
# Mark Koennecke, September 2010
|
||||
#-------------------------------------------------------
|
||||
|
||||
namespace eval ccdwww {}
|
||||
#-------------------------------------------------------
|
||||
# This is a default init script. The user has to initialise
|
||||
# a list of nodes to send to the CCD in XML format as
|
||||
# variable ccdwww::initnodes
|
||||
#--------------------------------------------------------
|
||||
proc ccdwww::initscript {name} {
|
||||
global ccdwww::initnodes
|
||||
|
||||
append confdata "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
|
||||
foreach var $ccdwww::initnodes {
|
||||
set val [hval /sics/${name}/${var}]
|
||||
append confdata "<$var>$val</$var>\n"
|
||||
}
|
||||
return $confdata
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc ccdwww::httpsend {url} {
|
||||
sct send $url
|
||||
return httpreply
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc ccdwww::httpsendstart {url} {
|
||||
sct send $url
|
||||
return httpstartreply
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc ccdwww::httptest {data} {
|
||||
if {[string first ASCERR $data] >= 0} {
|
||||
error $data
|
||||
}
|
||||
if {[string first ERROR $data] >= 0} {
|
||||
error $data
|
||||
}
|
||||
return $data
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc ccdwww::httpreply {} {
|
||||
set reply [sct result]
|
||||
set status [catch {httptest $reply} data]
|
||||
if {$status != 0} {
|
||||
sct geterror $data
|
||||
clientput $data
|
||||
} else {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
return idle
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
proc ccdwww::httpstartreply {} {
|
||||
set reply [sct result]
|
||||
set status [catch {httptest $reply} data]
|
||||
if {$status != 0} {
|
||||
sct geterror $data
|
||||
} else {
|
||||
hdelprop [sct] geterror
|
||||
}
|
||||
clientput $data
|
||||
after 100
|
||||
return idle
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
# A CCD works like a camera. When exposing, it cannot be stopped,
|
||||
# paused or anything. This is why the appropriate methods
|
||||
# here have no implementation
|
||||
#----------------------------------------------------------
|
||||
proc ccdwww::httpcontrol {} {
|
||||
set target [sct target]
|
||||
switch $target {
|
||||
1000 {
|
||||
set path [file dirname [sct]]
|
||||
set preset [hval $path/preset]
|
||||
set ret [ccdwww::httpsendstart "/ccd/expose?time=$preset"]
|
||||
hupdate $path/status run
|
||||
[sct controller] queue $path/status progress read
|
||||
return $ret
|
||||
}
|
||||
1001 {}
|
||||
1002 {}
|
||||
1003 {}
|
||||
1005 {
|
||||
set path [file dirname [sct]]
|
||||
set script [hval $path/initscript]
|
||||
set confdata [eval $script]
|
||||
clientput $confdata
|
||||
return [ccdwww::httpsend "post:/ccd/configure:$confdata"]
|
||||
}
|
||||
default {
|
||||
sct print "ERROR: bad start target $target given to control"
|
||||
return idle
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
proc ccdwww::httpdata {name} {
|
||||
set path "/sics/${name}/data"
|
||||
set com [format "node:%s:/ccd/data" $path]
|
||||
sct send $com
|
||||
return httpdatareply
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc ccdwww::httpdatareply {} {
|
||||
set status [catch {httpreply} txt]
|
||||
if {$status == 0} {
|
||||
set path [file dirname [sct]]
|
||||
hdelprop $path/data geterror
|
||||
}
|
||||
return idle
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc ccdwww::httpstatus {} {
|
||||
sct send /ccd/locked
|
||||
return httpevalstatus
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc ccdwww::httpstatusdata {} {
|
||||
catch {httpdatareply}
|
||||
sct update idle
|
||||
return idle
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
proc ccdwww::httpevalstatus {name} {
|
||||
set reply [sct result]
|
||||
set status [catch {httptest $reply} data]
|
||||
if {$status != 0} {
|
||||
sct geterror $data
|
||||
clientput $data
|
||||
sct update error
|
||||
return idle
|
||||
}
|
||||
hdelprop [sct] geterror
|
||||
if {$data == 0} {
|
||||
httpdata $name
|
||||
return httpstatusdata
|
||||
} else {
|
||||
sct update run
|
||||
[sct controller] queue [sct] progress read
|
||||
return idle
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
proc ccdwww::MakeCCDWWW {name host initscript} {
|
||||
sicsdatafactory new ${name}transfer
|
||||
makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600
|
||||
MakeSecHM $name 2
|
||||
hsetprop /sics/${name}/control write ccdwww::httpcontrol
|
||||
hsetprop /sics/${name}/control httpreply ccdwww::httpreply
|
||||
hsetprop /sics/${name}/control httpstartreply ccdwww::httpstartreply
|
||||
${name}sct write /sics/${name}/control
|
||||
|
||||
hsetprop /sics/${name}/data read ccdwww::httpdata $name
|
||||
hsetprop /sics/${name}/data httpdatareply ccdwww::httpdatareply
|
||||
|
||||
hsetprop /sics/${name}/status read ccdwww::httpstatus
|
||||
hsetprop /sics/${name}/status httpevalstatus ccdwww::httpevalstatus $name
|
||||
hsetprop /sics/${name}/status httpstatusdata ccdwww::httpstatusdata
|
||||
${name}sct poll /sics/${name}/status 60
|
||||
|
||||
hfactory /sics/${name}/initscript plain mugger text
|
||||
hset /sics/${name}/initscript $initscript
|
||||
}
|
||||
Reference in New Issue
Block a user