- Fixed various Tcl drivers at startup

- Added a sinqhttp driver for the second generation HM object

tcl/sinqhttp.tcl

@@ -0,0 +1,147 @@
+#--------------------------------------------------------
+# This is an asynchronous scriptcontext driven driver for 
+# the SINQ style http based histogram memory. 
+#
+# script chains:
+# -- control
+#       hmhttpcontrol - hmhttpreply
+# -- data
+#       hmhttpdata - hmhttpreply
+# -- status
+#       hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata
+#
+# copyright: see file COPYRIGHT
+#
+# Mark Koennecke, May 2009
+#---------------------------------------------------------
+proc hmhttpsend {url} {
+    sct send $url
+    return hmhttpreply
+}
+#--------------------------------------------------------
+proc hmhttptest {data} {
+    if {[string first ASCERR $data] >= 0} {
+	error $data
+    }
+    if {[string first ERROR $data] >= 0} {
+	error $data
+    }
+    return $data
+}
+#--------------------------------------------------------
+proc hmhttpreply {} {
+    set reply [sct result]
+    set status [catch {hmhttptest $reply} data]
+    if {$status != 0} {
+	sct geterror $data
+	clientput $data
+    } else {
+	hdelprop [sct] geterror
+    }
+    return idle
+}
+#---------------------------------------------------------
+proc hmhttpcontrol {} {
+    set target [sct target]
+    switch $target {
+	1000 {
+            set ret  [hmhttpsend "/admin/startdaq.egi"]
+	    set path [file dirname [sct]]
+	    [sct controller] queue $path/status progress read
+	    return $ret
+	}
+	1001 {return [hmhttpsend "/admin/stopdaq.egi"] }
+	1002 {return [hmhttpsend "/admin/pausedaq.egi"] }
+	1003 {return [hmhttpsend "/admin/continuedaq.egi"]}
+        1005 {
+	    set path [file dirname [sct]]
+	    set script [hval $path/initscript]
+	    set confdata [eval $script]
+	    return [hmhttpsend "post:/admin/configure.egi:$confdata"]
+	}
+	default {
+	    sct print "ERROR: bad start target $target given to control"
+	    return idle
+	}
+    }
+}
+#---------------------------------------------------------
+proc hmhttpdata {name} {
+    set len [hval /sics/${name}/datalength]
+    set path "/sics/${name}/data"
+    set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len]
+    sct send $com
+    return hmhttpdatareply
+}
+#--------------------------------------------------------
+proc hmhttpdatareply {} {
+    set status [catch {hmhttpreply} txt]
+    if {$status == 0} {
+	set path [file dirname [sct]]
+	hdelprop $path/data geterror 
+    }
+    return idle
+}
+#--------------------------------------------------------
+proc hmhttpstatus {} {
+    sct send /admin/textstatus.egi
+    return hmhttpevalstatus
+}
+#-------------------------------------------------------
+proc hmhttpstatusdata {} {
+    catch {hmhttpdatareply}
+    sct update idle
+    return idle
+}
+#---------------------------------------------------------
+proc hmhttpevalstatus {name} {
+    set reply [sct result]
+    set status [catch {hmhttptest $reply} data]
+    if {$status != 0} {
+	sct geterror $data
+	clientput $data
+	sct update error
+	return idle
+    } 
+    hdelprop [sct] geterror
+    set lines [split $data \n]
+    foreach line $lines {
+	set ld [split $line :]
+	sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]]
+    } 
+    set daq [sct DAQ]
+    set old [hval [sct]]
+    if {$daq == 1} {
+	sct update run
+	[sct controller] queue [sct] progress read
+	return idle
+    } else {
+	if {[string compare $old idle] != 0} {
+	    hmhttpdata $name
+	    return hmhttpstatusdata
+	} else {
+	    return idle
+	}
+    }
+}
+#---------------------------------------------------------
+proc MakeHTTPHM {name rank host initscript {tof NULL} } {
+    sicsdatafactory new ${name}transfer
+    makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007
+    MakeSecHM $name $rank $tof
+    hsetprop /sics/${name}/control write hmhttpcontrol
+    hsetprop /sics/${name}/control hmhttpreply  hmhttpreply
+    ${name}sct write /sics/${name}/control
+
+    hsetprop /sics/${name}/data read hmhttpdata $name
+    hsetprop /sics/${name}/data hmhttpdatareply  hmhttpdatareply
+    ${name}sct poll /sics/${name}/data 120
+
+    hsetprop /sics/${name}/status read hmhttpstatus
+    hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name
+    hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata
+    ${name}sct poll /sics/${name}/status 60
+
+    hfactory /sics/${name}/initscript plain mugger text
+    hset /sics/${name}/initscript $initscript
+}