epics/utilities
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

some flags and infos added

Browse Source
This commit is contained in:
zimoch
2006-03-29 09:20:07 +00:00
parent 09ad386588
commit 9191b5f9f9
1 changed files with 101 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ca
+101 -60
View File
@@ -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] <channel> [<channel> ...]}
puts { cagets [flags] <channel> [<channel> ...]}
puts { caput [flags] <channel> <value> [<channel> <value> ...]}
puts { caputq [flags] <channel> <value> [<channel> <value> ...]}
puts { cainfo [flags] <channel> [<channel> ...]}
puts { camon [flags] <channel> [<channel> ...]}
puts { cado [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 {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 <digits> override the PREC field}
puts {-plain don't do any formatting}
puts {-timeout <sec> timeout cawait after <sec> 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\""
}
}
}
}