bug fix in cawait if ENUM and -num
This commit is contained in:
@@ -2,16 +2,17 @@
|
||||
|
||||
# ca* by Dirk Zimoch
|
||||
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
# $Date: 2015/03/30 13:06:39 $
|
||||
# $Date: 2015/03/31 15:46:11 $
|
||||
|
||||
regsub -all {\$} {ca* by Dirk Zimoch
|
||||
$Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
$Revision: 1.26 $
|
||||
$Date: 2015/03/30 13:06:39 $} {} version
|
||||
$Revision: 1.27 $
|
||||
$Date: 2015/03/31 15:46:11 $} {} version
|
||||
|
||||
package require Tclx
|
||||
package require Epics
|
||||
|
||||
# possible flags and what they are for
|
||||
set possFlags(-date) " add record execution date"
|
||||
set possFlags(-d) " same as -date"
|
||||
set possFlags(-localdate) " add host date"
|
||||
@@ -30,10 +31,7 @@ set possFlags(-timeout) " <sec> timeout cawait after <sec> seconds"
|
||||
set possFlags(-num) " show enums as numeric values"
|
||||
set possFlags(-n) " <num> exit after <num> updates (for camon)"
|
||||
set possFlags(-version) " print version and exit"
|
||||
set possFlags(-ver) " same as -version"
|
||||
set possFlags(-v) " same as -version"
|
||||
set possFlags(-help) " print this help text and exit"
|
||||
set possFlags(-h) " same as -help"
|
||||
|
||||
proc printHelp {} {
|
||||
global possFlags
|
||||
@@ -65,6 +63,12 @@ proc check_n {i} {
|
||||
set n $i
|
||||
if {[catch {incr n}]} {puts stderr "-n flag expects an integer"; set n 1}
|
||||
}
|
||||
proc check_flag {f} {
|
||||
global flags possFlags
|
||||
if {[clength [array names possFlags -exact $f]] > 0} {
|
||||
lappend flags $f
|
||||
} else {puts stderr "not valid flag: $f"}
|
||||
}
|
||||
|
||||
if {![regexp {gets|get|putq|put|info|mon|do|wait} [file tail $argv0] command]} {
|
||||
if [regexp {gets|get|putq|put|info|mon|do|wait} [lindex $argv 0] command] {
|
||||
@@ -78,24 +82,21 @@ if {![regexp {gets|get|putq|put|info|mon|do|wait} [file tail $argv0] command]} {
|
||||
set flags {}
|
||||
set n 0
|
||||
while {[string match "-*" [set flag [lindex $argv 0]]]} {
|
||||
if {[clength [array names possFlags -exact $flag]] > 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] }
|
||||
{^-prec} { set prec [lindex $argv 1]
|
||||
set argv [lrange $argv 2 end] }
|
||||
{^-num} { lappend flags $flag
|
||||
set argv [lrange $argv 1 end] }
|
||||
{^-n} { check_n [lindex $argv 1];
|
||||
set argv [lrange $argv 2 end] }
|
||||
default { lappend flags $flag
|
||||
set argv [lrange $argv 1 end] }
|
||||
}
|
||||
} else {set argv [lrange $argv 1 end]; append erme " $flag"}
|
||||
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] }
|
||||
{^-prec} { set prec [lindex $argv 1]
|
||||
set argv [lrange $argv 2 end] }
|
||||
{^-num} { lappend flags $flag
|
||||
set argv [lrange $argv 1 end] }
|
||||
{^-n} { check_n [lindex $argv 1];
|
||||
set argv [lrange $argv 2 end] }
|
||||
default { check_flag $flag
|
||||
set argv [lrange $argv 1 end] }
|
||||
}
|
||||
}
|
||||
if {[info exists erme]} {puts stderr "not valid flag(s): $erme"; unset erme}
|
||||
if {[llength $argv] == 0} { printHelp; exit 1 }
|
||||
|
||||
proc bgerror {msg} {
|
||||
@@ -241,7 +242,7 @@ proc parsecond {cond} {
|
||||
}
|
||||
|
||||
proc monitor {channel condition io value stat sevr time} {
|
||||
global info oldval n
|
||||
global info oldval n flags
|
||||
if {$io != "OK"} {
|
||||
unset info($channel)
|
||||
unset oldval($channel)
|
||||
@@ -251,6 +252,9 @@ proc monitor {channel condition io value stat sevr time} {
|
||||
if {![info exists info($channel)]} {
|
||||
set info($channel) [pvinfo $channel]
|
||||
}
|
||||
foreach {attr val} $info($channel) {
|
||||
set $attr $val
|
||||
}
|
||||
set newval [formatval $channel $value $stat $sevr $time]
|
||||
if {$condition == {}} {
|
||||
if {[info exists oldval($channel)] && $oldval($channel) == $newval} return
|
||||
@@ -259,10 +263,15 @@ proc monitor {channel condition io value stat sevr time} {
|
||||
if {$n > 0 && [incr n -1] < 1} { exit }
|
||||
return
|
||||
}
|
||||
if {$TYPE == "DBF_ENUM" && [lsearch $flags -num] >= 0} {
|
||||
set v [lsearch $ENUM $value]
|
||||
if {$v != -1} {set value $v}
|
||||
}
|
||||
|
||||
if [expr $condition] {
|
||||
puts $newval
|
||||
exit
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
set faults 0
|
||||
|
||||
Reference in New Issue
Block a user