From 41bfd5057f5dadd8e387f049367486b131313012 Mon Sep 17 00:00:00 2001 From: zimoch Date: Fri, 25 Jul 2003 15:45:23 +0000 Subject: [PATCH] added timeout to cawait removed some debug output shifted things araound --- ca | 112 +++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 61 insertions(+), 51 deletions(-) diff --git a/ca b/ca index fb9d077..ed07599 100755 --- a/ca +++ b/ca @@ -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] [ ...]} puts { caput [flags] [ ...]} puts { cainfo [flags] [ ...]} puts { camon [flags] [ ...]} puts { cado [flags] [ ...]} puts { cagets [flags] [ ...]} - puts { cawait [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 {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 timeout cawait after 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 {