added cawait
This commit is contained in:
zimoch
@@ -1,43 +1,22 @@
|
||||
#!/usr/bin/tclsh
|
||||
# $Id: ca,v 1.10 2003/04/10 14:16:41 zimoch Exp $
|
||||
|
||||
# ca* by Dirk Zimoch
|
||||
# $Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
# $Log: ca,v $
|
||||
# Revision 1.10 2003/04/10 14:16:41 zimoch
|
||||
# debufoutput removed
|
||||
#
|
||||
# Revision 1.9 2003/04/10 14:10:21 zimoch
|
||||
# added "" to all string/enum values
|
||||
#
|
||||
# Revision 1.8 2003/04/10 12:53:36 zimoch
|
||||
# added -hex flag
|
||||
#
|
||||
# Revision 1.7 2003/04/07 09:19:57 zimoch
|
||||
# added exitstatus and some flags
|
||||
#
|
||||
# Revision 1.6 2002/12/17 17:34:49 zimoch
|
||||
# debugged
|
||||
#
|
||||
# Revision 1.5 2002/12/17 17:24:47 zimoch
|
||||
# help added
|
||||
#
|
||||
# Revision 1.4 2002/10/02 08:38:10 zimoch
|
||||
# Original DELTA version with CVS tags
|
||||
#
|
||||
#
|
||||
# $Date: 2003/07/24 17:05:56 $
|
||||
|
||||
regsub -all {\$} {ca* by Dirk Zimoch
|
||||
$Source: /cvs/G/EPICS/App/scripts/ca,v $
|
||||
$Revision: 1.10 $
|
||||
$Date: 2003/04/10 14:16:41 $} {} version
|
||||
$Revision: 1.11 $
|
||||
$Date: 2003/07/24 17:05:56 $} {} version
|
||||
|
||||
set auto_path [concat $env(SLSBASE)/lib/tcl $auto_path]
|
||||
package require Epics
|
||||
|
||||
if {![regexp {gets|get|put|info|mon|do} [file tail $argv0] command]} {
|
||||
if [regexp {gets|get|put|info|mon|do} [lindex $argv 0] command] {
|
||||
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"
|
||||
puts stderr "unknown command: should be one of gets, get, put, info, mon, do, wait"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
@@ -59,14 +38,16 @@ if {[lsearch -regexp $flags {(\?)|(h(elp)?)$}] != -1 || [llength $argv] == 0} {
|
||||
puts { cainfo [flags] <channel> [<channel> ...]}
|
||||
puts { camon [flags] <channel> [<channel> ...]}
|
||||
puts { cado [flags] <channel> [<channel> ...]}
|
||||
puts { cagets [flags] <channel> [<channel> ...]
|
||||
puts { cagets [flags] <channel> [<channel> ...]}
|
||||
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 {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}
|
||||
@@ -159,7 +140,29 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} {
|
||||
return [concat $time $channel $formatted $EGU $status]
|
||||
}
|
||||
|
||||
proc monitor {channel io value stat sevr time} {
|
||||
proc parsecond {cond} {
|
||||
set cond [string trim $cond]
|
||||
if {[string index $cond 0] == "!"} {
|
||||
puts -nonewline stderr "not "
|
||||
return "!([parsecond [string range $cond 1 end]])"
|
||||
}
|
||||
if [regexp {^(.*)\.\.\.(.*)} $cond match v1 v2] {
|
||||
puts stderr "in range $v1 ... $v2"
|
||||
return "\$value >= \"$v1\" && \$value <= \"$v2\""
|
||||
}
|
||||
if [regexp {^(<=|>=|<|>|==)(.*)} $cond match op val] {
|
||||
puts stderr "$op $val"
|
||||
return "\$value $op \"$val\""
|
||||
}
|
||||
if {[string index $cond 0] == "="} {
|
||||
puts stderr "== [string range $cond 1 end]"
|
||||
return "\$value == \"[string range $cond 1 end]\""
|
||||
}
|
||||
puts stderr "== $cond"
|
||||
return "\$value == \"$cond\""
|
||||
}
|
||||
|
||||
proc monitor {channel condition io value stat sevr time} {
|
||||
global info oldval
|
||||
if {$io != "OK"} {
|
||||
unset info($channel)
|
||||
@@ -171,64 +174,96 @@ proc monitor {channel io value stat sevr time} {
|
||||
set info($channel) [pvinfo $channel]
|
||||
}
|
||||
set newval [formatval $channel $value $stat $sevr $time]
|
||||
if {[info exists oldval($channel)] && $oldval($channel) == $newval} return
|
||||
set oldval($channel) $newval
|
||||
puts $newval
|
||||
}
|
||||
|
||||
set exitstatus 0
|
||||
if {$command == "gets"} {
|
||||
foreach channel $argv {
|
||||
regexp {^[^\.]*} $channel base
|
||||
if [catch {pvput $base.PROC 1} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
incr exitstatus
|
||||
}
|
||||
if {$condition == {}} {
|
||||
if {[info exists oldval($channel)] && $oldval($channel) == $newval} return
|
||||
set oldval($channel) $newval
|
||||
puts $newval
|
||||
return
|
||||
}
|
||||
if [expr $condition] {
|
||||
puts $newval
|
||||
exit
|
||||
}
|
||||
}
|
||||
|
||||
if {$command == "put"} {
|
||||
set channels {}
|
||||
foreach {channel setvalue} $argv {
|
||||
if [catch {
|
||||
pvput $channel $setvalue
|
||||
} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
incr exitstatus
|
||||
set faults 0
|
||||
|
||||
switch $command {
|
||||
"do" {
|
||||
foreach channel $argv {
|
||||
if [catch {pvputq $channel 1} msg] {
|
||||
puts stderr "pvputq: $msg"
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
if [catch {
|
||||
pvget $channel
|
||||
lappend channels $channel
|
||||
} msg] {
|
||||
puts stderr "pvget: $msg"
|
||||
incr exitstatus
|
||||
exit $faults
|
||||
}
|
||||
"gets" {
|
||||
set channels $argv
|
||||
foreach channel $argv {
|
||||
regexp {^[^\.]*} $channel base
|
||||
if [catch {pvput $base.PROC 1} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
set channels $argv
|
||||
"put" {
|
||||
set channels {}
|
||||
foreach {channel setvalue} $argv {
|
||||
if [catch {
|
||||
pvput $channel $setvalue
|
||||
} msg] {
|
||||
puts stderr "pvput: $msg"
|
||||
incr faults
|
||||
}
|
||||
if [catch {
|
||||
pvget $channel
|
||||
lappend channels $channel
|
||||
} msg] {
|
||||
puts stderr "pvget: $msg"
|
||||
incr faults
|
||||
}
|
||||
}
|
||||
}
|
||||
"mon" {
|
||||
foreach channel $argv {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
incr faults
|
||||
}
|
||||
if [catch {pvmon $channel "monitor $channel {}"} msg] {
|
||||
puts stderr "pvmon: $msg"
|
||||
}
|
||||
}
|
||||
catch {vwait forever}
|
||||
exit
|
||||
}
|
||||
"wait" {
|
||||
foreach {channel condition} $argv {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
incr faults
|
||||
}
|
||||
if [catch {pvmon $channel "monitor $channel [list [parsecond $condition]]"} msg] {
|
||||
puts stderr "pvmon: $msg"
|
||||
}
|
||||
}
|
||||
catch {vwait forever}
|
||||
exit
|
||||
}
|
||||
default {
|
||||
set channels $argv
|
||||
}
|
||||
}
|
||||
|
||||
if {$command == "do"} {
|
||||
foreach channel $channels {
|
||||
if [catch {pvputq $channel 1} msg] {
|
||||
puts stderr "pvputq: $msg"
|
||||
incr exitstatus
|
||||
}
|
||||
}
|
||||
exit $exitstatus
|
||||
}
|
||||
|
||||
foreach channel $channels {
|
||||
if [catch {set info($channel) [pvinfo $channel]} msg] {
|
||||
puts stderr "pvinfo: $msg"
|
||||
incr exitstatus
|
||||
incr faults
|
||||
}
|
||||
switch $command {
|
||||
"mon" {
|
||||
if [catch {pvmon $channel "monitor $channel"} msg] {
|
||||
puts stderr "pvmon: $msg"
|
||||
}
|
||||
}
|
||||
"put" -
|
||||
"gets" -
|
||||
"get" {
|
||||
@@ -244,6 +279,5 @@ foreach channel $channels {
|
||||
}
|
||||
}
|
||||
|
||||
if {$command == "mon"} {vwait forever}
|
||||
exit $exitstatus
|
||||
exit $faults
|
||||
|
||||
|
||||
Reference in New Issue
Block a user