diff --git a/ca b/ca index 2a01b34..fb9d077 100755 --- a/ca +++ b/ca @@ -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] [ ...]} puts { camon [flags] [ ...]} puts { cado [flags] [ ...]} - puts { cagets [flags] [ ...] + puts { cagets [flags] [ ...]} + puts { cawait [flags] '' [ ...] } 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