From 9191b5f9f9916328f9bce9ca6e72c09f0e2c0cf5 Mon Sep 17 00:00:00 2001 From: zimoch Date: Wed, 29 Mar 2006 09:20:07 +0000 Subject: [PATCH] some flags and infos added --- ca | 161 ++++++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 101 insertions(+), 60 deletions(-) diff --git a/ca b/ca index ed07599..3376f62 100755 --- a/ca +++ b/ca @@ -2,39 +2,32 @@ # ca* by Dirk Zimoch # $Source: /cvs/G/EPICS/App/scripts/ca,v $ -# $Date: 2003/07/25 15:45:23 $ +# $Date: 2006/03/29 09:20:07 $ regsub -all {\$} {ca* by Dirk Zimoch $Source: /cvs/G/EPICS/App/scripts/ca,v $ -$Revision: 1.12 $ -$Date: 2003/07/25 15:45:23 $} {} version +$Revision: 1.13 $ +$Date: 2006/03/29 09:20:07 $} {} version set auto_path [concat $env(SLSBASE)/lib/tcl $auto_path] -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 { - printHelp - exit 1 - } -} - proc printHelp {} { puts {usage: caget [flags] [ ...]} + puts { cagets [flags] [ ...]} puts { caput [flags] [ ...]} + puts { caputq [flags] [ ...]} puts { cainfo [flags] [ ...]} puts { camon [flags] [ ...]} puts { cado [flags] [ ...]} - puts { cagets [flags] [ ...]} puts { cawait [flags] '' [ ''...] } puts {caget reads and formats values from channels (arrays too)} + puts {cagets writes 1 to .PROC and reads after processing has finished} puts {caput writes, waits until processing finishes and reads back} + puts {caputq writes but does not wait for processing} 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:} @@ -47,20 +40,33 @@ proc printHelp {} { puts {-stat always add severity and status} puts {-nostat never add severity and status} puts {-hex show integer values as hex} + puts {-prec override the PREC field} + puts {-plain don't do any formatting} puts {-timeout timeout cawait after seconds} puts {-version print version and exit} puts {-help print this help text and exit} } +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] { + set argv [lrange $argv 1 end] + } else { + printHelp + exit 1 + } +} + 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] } + {^-(\?)|(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] } + default { lappend flags $flag + set argv [lrange $argv 1 end] } } } @@ -74,52 +80,69 @@ proc bgerror {msg} { } proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} { - global info flags + global info flags prec set clock [clock seconds] set EGU "" foreach {attr val} $info($channel) { set $attr $val } - if [string match *.* $channel] { - catch {unset PREC} - set EGU "" - } - if {$time == {}} { - set value $VAL - set stat $STAT - set sevr $SEVR - set time $TIME - } - if {$SIZE == 1} { - set value [list $value] - } - foreach val $value { - if [info exists PREC] { - if {$PREC < 0} { - set val [format "%.[expr -$PREC]e" $val] - } else { - set val [format "%.${PREC}f" $val] - } - } - if {[lsearch $flags -hex] != -1} { - catch { - set val [format "0x%x" [expr int($val)]] - } - } - if {$TYPE == "DBF_STRING" || $TYPE == "DBF_ENUM"} { - set val \"$val\" - } - lappend formatted $val - } - if {$SIZE > 1} { - set formatted \{[join $formatted]\} - } else { - set formatted [lindex $formatted 0] - } - if {[lsearch $flags -stat] != -1 || $sevr != "NO_ALARM"} { - set status " (SEVR:$sevr STAT:$stat)" - } else { + if {[lsearch $flags -plain] != -1} { + set formatted $VAL set status "" + set channel "" + set EGU "" + } else { + if [string match *.* $channel] { + if [info exists PREC] { + if [info exists prec] { + set PREC $prec + } else { + unset PREC + } + } + set EGU "" + } + if {[info exists PREC] && [info exists prec]} { + set PREC $prec + } + if {$time == {}} { + set value $VAL + set stat $STAT + set sevr $SEVR + set time $TIME + } + if {$SIZE == 1} { + set value [list $value] + } + foreach val $value { + if [info exists PREC] { + if {$PREC < 0} { + set val [format "%.[expr -$PREC]e" $val] + } else { + set val [format "%.${PREC}f" $val] + } + } + if {$TYPE == "DBF_STRING" || $TYPE == "DBF_ENUM"} { + set val \"$val\" + } else { + if {[lsearch $flags -hex] != -1} { + catch { + set val [format "0x%x" [expr int($val)]] + } + } + } + lappend formatted $val + } + if {$SIZE > 1} { + set formatted \{[join $formatted]\} + } else { + set formatted [lindex $formatted 0] + } + if {[lsearch $flags -stat] != -1 || $sevr != "NO_ALARM"} { + set status " (SEVR:$sevr STAT:$stat)" + } else { + set status "" + } } if {[scan $time "%d/%d/%d %d:%d:%f" m d y H M S] != 6} { set m 0 @@ -202,6 +225,15 @@ switch $command { } exit $faults } + "putq" { + foreach {channel setvalue} $argv { + if [catch {pvputq $channel $setvalue} msg] { + puts stderr $msg + incr faults + } + } + exit $faults + } "gets" { set channels $argv foreach channel $argv { @@ -285,6 +317,15 @@ foreach channel $channels { if [info exists info($channel)] { puts "$channel:\n$info($channel)" } + regexp {^[^\.]*} $channel base + catch { + set rtyp [pvget $base.RTYP] + puts "RTYP\t$rtyp" + } + catch { + set desc [pvget $base.DESC] + puts "DESC\t\"$desc\"" + } } } }