diff --git a/ca b/ca index fb98f10..c2ccb9b 100755 --- a/ca +++ b/ca @@ -2,12 +2,12 @@ # ca* by Dirk Zimoch # $Source: /cvs/G/EPICS/App/scripts/ca,v $ -# $Date: 2013/04/16 10:12:11 $ +# $Date: 2013/07/11 09:49:48 $ regsub -all {\$} {ca* by Dirk Zimoch $Source: /cvs/G/EPICS/App/scripts/ca,v $ -$Revision: 1.24 $ -$Date: 2013/04/16 10:12:11 $} {} version +$Revision: 1.25 $ +$Date: 2013/07/11 09:49:48 $} {} version proc printHelp {} { puts {usage: caget [flags] [ ...]} @@ -36,7 +36,7 @@ proc printHelp {} { puts {-stat always add severity and status} puts {-nostat never add severity and status} puts {-hex show integer values as hex} - puts {-num show numeric values instead of strings} + puts {-int show numeric values instead of strings} puts {-prec override the PREC field} puts {-plain don't do any formatting} puts {-timeout timeout cawait after seconds} @@ -88,29 +88,6 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} { foreach {attr val} $info($channel) { set $attr $val } - catch { - set null 0 - if {$TYPE == "DBF_CHAR" && $SIZE > 1 \ - && [lsearch $flags "-num"] == -1 \ - && [lsearch $flags "-int"] == -1 \ - && [lsearch $flags "-hex"] == -1} { - foreach char $VAL { - if {$null && $char != 0} { - error "Not printable" - } - if {($char & 0x7f) >= 0x20 || $char == 0x0a || $char == 0x0d && $char != 0x7f} { - append s [format "%c" $char] - } elseif {$char == 0} { - set null 1 - } else { - error "Not prinable" - } - } - set SIZE 1 - set TYPE DBF_STRING - set VAL $s - } - } if {[lsearch $flags -plain] != -1} { set formatted $VAL set status "" @@ -126,6 +103,33 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} { set sevr $SEVR set time $TIME } + if {$TYPE == "DBF_STRING" && [string length $value] == 39} { + puts "reread $channel as $channel$" + set value [pvget $channel$] + } + catch { + set null 0 + if {$TYPE == "DBF_CHAR" && $SIZE > 1 \ + && [lsearch $flags "-num"] == -1 \ + && [lsearch $flags "-int"] == -1 \ + && [lsearch $flags "-hex"] == -1} { + foreach char $value { + if {$null && $char != 0} { + error "Not printable" + } + if {($char & 0x7f) >= 0x20 || $char == 0x0a || $char == 0x0d && $char != 0x7f} { + append s [format "%c" $char] + } elseif {$char == 0} { + set null 1 + } else { + error "Not prinable" + } + } + set SIZE 1 + set TYPE DBF_STRING + set value $s + } + } if {$SIZE == 1} { set value [list $value] } @@ -153,6 +157,7 @@ proc formatval {channel {value {}} {sevr {}} {stat {}} {time {}}} { } } lappend formatted $val + set EGU "" } if {$SIZE > 1} { set formatted \{[join $formatted]\} @@ -248,15 +253,6 @@ 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 { @@ -267,16 +263,43 @@ switch $command { } } } + "putq" - "put" { set channels {} foreach {channel setvalue} $argv { + if [catch {set info($channel) [pvinfo $channel]} msg] { + puts stderr $msg + incr faults + continue + } + foreach {attr value} $info($channel) { + set $attr $value + } + if {$TYPE == "DBF_CHAR" && $SIZE > 1 && \ + [lsearch $flags "-int"] == -1 && \ + [lsearch $flags "-hex"] == -1} { + set a {} + for {set i 0} {$i < $SIZE} {incr i} { + if {[scan [string index $setvalue $i] "%c" c] == -1} { + set c 0 + } + lappend a $c + } + set setvalue $a + } if [catch { - pvput $channel $setvalue - lappend channels $channel + if {$command == "putq"} { + pvputq $channel $setvalue + } else { + pvput $channel $setvalue + pvget $channel + lappend channels $channel + } } msg] { puts stderr $msg incr faults } + if {$command == "putq"} { exit $faults } } } "mon" { diff --git a/shellbox.tcl b/shellbox.tcl index e35ffaa..12a2479 100755 --- a/shellbox.tcl +++ b/shellbox.tcl @@ -32,8 +32,8 @@ set timeout -1 regsub -all {\$} {shellbox by Dirk Zimoch $Source: /cvs/G/EPICS/App/scripts/shellbox.tcl,v $ -$Revision: 1.9 $ -$Date: 2011/03/02 09:21:46 $} {} version +$Revision: 1.10 $ +$Date: 2013/07/11 09:49:48 $} {} version proc usage {} { puts "usage: shellbox \[options\] port command args" @@ -70,7 +70,7 @@ proc connectionHandler {channel addr port} { global channels command clientinfo set peer [fconfigure $channel -peername] set clientinfo($channel) [lindex $peer 1]:[lindex $peer 2] - fconfigure $channel -blocking no -buffering none + fconfigure $channel -blocking no -buffering none -encoding binary # do some telnet magic to change from line-mode to char-mode puts -nonewline $channel "\xff\xfb\x03\xff\xfb\x01" fileevent $channel readable "inputHandler $channel" @@ -144,22 +144,21 @@ proc startProgram {} { catch {puts stderr "shellbox: $msg"} exit 3 } - forwardOutput "**** '$command' started in [pwd] ****\n" + forwardOutput "**** '$command' (pid [exp_pid]) started in [pwd] ****\n" expect_background { - kill { + "kill" { killProgram } ? { forwardOutput $expect_out(buffer) } eof { - puts "EOF received" + forwardOutput "**** '$command' (pid [exp_pid]) sent EOF ****\n" + wait [exp_pid] if ($diedyoung) { - forwardOutput $expect_out(buffer) - forwardOutput "**** first run of '$command' died within first 10 seconds. I will quit. ****\n" + forwardOutput "**** first run died within first 10 seconds. I will quit. ****\n" exit 4 } - forwardOutput $expect_out(buffer) forwardOutput "**** '$command' died ****\n" after idle startProgram } @@ -167,11 +166,15 @@ proc startProgram {} { } proc killProgram {} { - global command - forwardOutput "**** killing '$command' ****\n" - exec kill -s SIGKILL [exp_pid] - wait + global command spawn_id + forwardOutput "**** killing '$command' (pid [exp_pid])****\n" + if [catch {exec kill -s SIGHUP [exp_pid]} msg] {forwardOutput "**** hangup failed: $msg ****\n"} + after 1000 + if [catch {exec kill -s SIGKILL [exp_pid]} msg] {forwardOutput "**** kill failed: $msg ****\n"} + after 1000 forwardOutput "**** '$command' killed ****\n" + wait [exp_pid] + expect "*" } set paranoid 0