added timeout to cawait
removed some debug output shifted things araound
This commit is contained in:
zimoch
@@ -2,68 +2,72 @@
|
||||
|
||||
# ca* by Dirk Zimoch
|
||||
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
# $Date: 2003/07/24 17:05:56 $
|
||||
# $Date: 2003/07/25 15:45:23 $
|
||||
|
||||
regsub -all {\$} {ca* by Dirk Zimoch
|
||||
$Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
$Revision: 1.11 $
|
||||
$Date: 2003/07/24 17:05:56 $} {} version
|
||||
$Revision: 1.12 $
|
||||
$Date: 2003/07/25 15:45:23 $} {} version
|
||||
|
||||
set auto_path [concat $env(SLSBASE)/lib/tcl $auto_path]
|
||||
package require Epics
|
||||
|
||||
if {![regexp {gets|get|put|info|mon|do|wait} [file tail $argv0] command]} {
|
||||
if [regexp {gets|get|put|info|mon|do|wait} [lindex $argv 0] command] {
|
||||
set argv [lrange $argv 1 end]
|
||||
} else {
|
||||
puts stderr "unknown command: should be one of gets, get, put, info, mon, do, wait"
|
||||
printHelp
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
|
||||
set flags {}
|
||||
while {[string match "-*" [lindex $argv 0]]} {
|
||||
lappend flags [lindex $argv 0]
|
||||
set argv [lrange $argv 1 end]
|
||||
}
|
||||
|
||||
if {[lsearch -regexp $flags {(v(er(sion)?)?)$}] != -1} {
|
||||
puts $version
|
||||
exit
|
||||
}
|
||||
|
||||
if {[lsearch -regexp $flags {(\?)|(h(elp)?)$}] != -1 || [llength $argv] == 0} {
|
||||
proc printHelp {} {
|
||||
puts {usage: caget [flags] <channel> [<channel> ...]}
|
||||
puts { caput [flags] <channel> <value> [<channel> <value> ...]}
|
||||
puts { cainfo [flags] <channel> [<channel> ...]}
|
||||
puts { camon [flags] <channel> [<channel> ...]}
|
||||
puts { cado [flags] <channel> [<channel> ...]}
|
||||
puts { cagets [flags] <channel> [<channel> ...]}
|
||||
puts { cawait [flags] <channel> '<condition>' [<channel> <condition>...]
|
||||
puts { cawait [flags] <channel> '<condition>' [<channel> '<condition>'...]
|
||||
}
|
||||
puts {caget reads and formats values from channels (arrays too)}
|
||||
puts {caput writes, waits until processing finishes and reads back}
|
||||
puts {cainfo reads additional information}
|
||||
puts {camon starts monitors (terminate with CTRL-C)}
|
||||
puts {cado writes 1 and does not wait}
|
||||
puts {cagets writes 1 to .PROC and reads after processing has finished}
|
||||
puts {cawait waits until any condition ('>4.3', '!3...5', etc) matches
|
||||
puts {caget reads and formats values from channels (arrays too)}
|
||||
puts {caput writes, waits until processing finishes and reads back}
|
||||
puts {cainfo reads additional information}
|
||||
puts {camon starts monitors (terminate with CTRL-C)}
|
||||
puts {cado writes 1 but does not wait for processing}
|
||||
puts {cagets writes 1 to .PROC and reads after processing has finished}
|
||||
puts {cawait waits until any condition ('>4.3', '!3...5', etc) matches
|
||||
}
|
||||
puts {accepted flags:}
|
||||
puts {-date add record execution date}
|
||||
puts {-localdate add host date}
|
||||
puts {-time add record execution time}
|
||||
puts {-localtime add host time}
|
||||
puts {-noname don't add channel name}
|
||||
puts {-nounit don't add units}
|
||||
puts {-stat always add severity/status}
|
||||
puts {-nostat never add severity/status}
|
||||
puts {-hex show integer values as hex}
|
||||
puts {-version print version and exit}
|
||||
puts {-help print this help text and exit}
|
||||
exit
|
||||
puts {-date add record execution date}
|
||||
puts {-localdate add host date}
|
||||
puts {-time add record execution time}
|
||||
puts {-localtime add host time}
|
||||
puts {-noname don't add channel name}
|
||||
puts {-nounit don't add units}
|
||||
puts {-stat always add severity and status}
|
||||
puts {-nostat never add severity and status}
|
||||
puts {-hex show integer values as hex}
|
||||
puts {-timeout <sec> timeout cawait after <sec> seconds}
|
||||
puts {-version print version and exit}
|
||||
puts {-help print this help text and exit}
|
||||
}
|
||||
|
||||
set flags {}
|
||||
while {[string match "-*" [set flag [lindex $argv 0]]]} {
|
||||
switch -regexp -- $flag {
|
||||
{(\?)|(h(elp)?)$} { printHelp; exit}
|
||||
{(v(er(sion)?)?)$} { puts $version; exit }
|
||||
{timeout} { set timeout [lindex $argv 1]
|
||||
set argv [lrange $argv 2 end] }
|
||||
default { lappend flags $flag
|
||||
set argv [lrange $argv 1 end] }
|
||||
}
|
||||
}
|
||||
|
||||
if {[llength $argv] == 0} { printHelp; exit 1 }
|
||||
|
||||
package require Epics
|
||||
|
||||
proc bgerror {msg} {
|
||||
global errorInfo
|
||||
puts stderr $errorInfo
|
||||
@@ -143,22 +147,22 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
|
||||
proc parsecond {cond} {
|
||||
set cond [string trim $cond]
|
||||
if {[string index $cond 0] == "!"} {
|
||||
puts -nonewline stderr "not "
|
||||
#puts -nonewline stderr "not "
|
||||
return "!([parsecond [string range $cond 1 end]])"
|
||||
}
|
||||
if [regexp {^(.*)\.\.\.(.*)} $cond match v1 v2] {
|
||||
puts stderr "in range $v1 ... $v2"
|
||||
#puts stderr "in range $v1 ... $v2"
|
||||
return "\$value >= \"$v1\" && \$value <= \"$v2\""
|
||||
}
|
||||
if [regexp {^(<=|>=|<|>|==)(.*)} $cond match op val] {
|
||||
puts stderr "$op $val"
|
||||
#puts stderr "$op $val"
|
||||
return "\$value $op \"$val\""
|
||||
}
|
||||
if {[string index $cond 0] == "="} {
|
||||
puts stderr "== [string range $cond 1 end]"
|
||||
#puts stderr "== [string range $cond 1 end]"
|
||||
return "\$value == \"[string range $cond 1 end]\""
|
||||
}
|
||||
puts stderr "== $cond"
|
||||
#puts stderr "== $cond"
|
||||
return "\$value == \"$cond\""
|
||||
}
|
||||
|
||||
@@ -192,7 +196,7 @@ switch $command {
|
||||
"do" {
|
||||
foreach channel $argv {
|
||||
if [catch {pvputq $channel 1} msg] {
|
||||
puts stderr "pvputq: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
@@ -203,7 +207,7 @@ switch $command {
|
||||
foreach channel $argv {
|
||||
regexp {^[^\.]*} $channel base
|
||||
if [catch {pvput $base.PROC 1} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
@@ -214,14 +218,14 @@ switch $command {
|
||||
if [catch {
|
||||
pvput $channel $setvalue
|
||||
} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
if [catch {
|
||||
pvget $channel
|
||||
lappend channels $channel
|
||||
} msg] {
|
||||
puts stderr "pvget: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
@@ -229,11 +233,11 @@ switch $command {
|
||||
"mon" {
|
||||
foreach channel $argv {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
if [catch {pvmon $channel "monitor $channel {}"} msg] {
|
||||
puts stderr "pvmon: $msg"
|
||||
puts stderr $msg
|
||||
}
|
||||
}
|
||||
catch {vwait forever}
|
||||
@@ -242,11 +246,17 @@ switch $command {
|
||||
"wait" {
|
||||
foreach {channel condition} $argv {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
if [catch {pvmon $channel "monitor $channel [list [parsecond $condition]]"} msg] {
|
||||
puts stderr "pvmon: $msg"
|
||||
puts stderr $msg
|
||||
}
|
||||
}
|
||||
if [info exists timeout] {
|
||||
after [expr int($timeout*1000)] {
|
||||
puts stderr "cawait timed out"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
catch {vwait forever}
|
||||
@@ -260,7 +270,7 @@ switch $command {
|
||||
|
||||
foreach channel $channels {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
puts stderr $msg
|
||||
incr faults
|
||||
}
|
||||
switch $command {
|
||||
|
||||
Reference in New Issue
Block a user