1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: exec - simple way to exec with streaming output |
---|
3 | # |
---|
4 | # This utility makes it easy to exec another tool and get streaming |
---|
5 | # output from stdout and stderr. Any stderr messages are specially |
---|
6 | # encoded with the =RAPPTURE-ERROR=> tag, so they show up in red |
---|
7 | # in the execution output. |
---|
8 | # ====================================================================== |
---|
9 | # AUTHOR: Michael McLennan, Purdue University |
---|
10 | # Copyright (c) 2004-2005 Purdue Research Foundation |
---|
11 | # |
---|
12 | # See the file "license.terms" for information on usage and |
---|
13 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
14 | # ====================================================================== |
---|
15 | package require BLT |
---|
16 | |
---|
17 | namespace eval Rappture { # forward declaration } |
---|
18 | |
---|
19 | # ---------------------------------------------------------------------- |
---|
20 | # USAGE: exec <arg> <arg>... |
---|
21 | # |
---|
22 | # This utility acts like the standard Tcl "exec" command, but it also |
---|
23 | # streams stdout and stderr messages while the command is executing, |
---|
24 | # instead of waiting till the end. Any error messages are prefixed |
---|
25 | # with the special =RAPPTURE-ERROR=> tag, so they are recognized as |
---|
26 | # errors within Rappture. |
---|
27 | # ---------------------------------------------------------------------- |
---|
28 | proc Rappture::exec {args} { |
---|
29 | variable execout |
---|
30 | variable execctl |
---|
31 | |
---|
32 | set execout(output) "" |
---|
33 | set execout(channel) "" |
---|
34 | set execout(extra) "" |
---|
35 | set execctl "" |
---|
36 | |
---|
37 | set status [catch {eval blt::bgexec ::Rappture::execctl \ |
---|
38 | -keepnewline yes \ |
---|
39 | -onoutput {{::Rappture::_exec_out stdout}} \ |
---|
40 | -onerror {{::Rappture::_exec_out stderr}} \ |
---|
41 | $args} result] |
---|
42 | |
---|
43 | # add any extra stuff pending from the last stdout/stderr change |
---|
44 | append execout(output) $execout(extra) |
---|
45 | |
---|
46 | if {$status != 0} { |
---|
47 | if {[regexp {^KILLED} $execctl] && [llength $execctl] == 4} { |
---|
48 | set reason [lindex $execctl end] |
---|
49 | set result "job killed: $reason" |
---|
50 | } |
---|
51 | error $result |
---|
52 | } |
---|
53 | return $execout(output) |
---|
54 | } |
---|
55 | |
---|
56 | # ---------------------------------------------------------------------- |
---|
57 | # USAGE: _exec_out <channel> <message> |
---|
58 | # |
---|
59 | # Called automatically whenever output comes in from the Rappture::exec |
---|
60 | # utility. Streams the output to stdout and adds it to the "execout" |
---|
61 | # variable, so it can be returned as one large string at the end of |
---|
62 | # the exec. |
---|
63 | # ---------------------------------------------------------------------- |
---|
64 | proc Rappture::_exec_out {channel message} { |
---|
65 | variable execout |
---|
66 | |
---|
67 | # |
---|
68 | # If this message is being written to the stderr channel, then |
---|
69 | # add the =RAPPTURE-ERROR=> prefix to each line. |
---|
70 | # |
---|
71 | if {$channel == "stderr"} { |
---|
72 | set newmesg "" |
---|
73 | foreach line [split $message \n] { |
---|
74 | append newmesg "=RAPPTURE-ERROR=>$line\n" |
---|
75 | } |
---|
76 | set message $newmesg |
---|
77 | } |
---|
78 | |
---|
79 | # |
---|
80 | # If this message is coming in on the same channel as the |
---|
81 | # last, then fine, add it on. But if it's coming in on a |
---|
82 | # different channel, we must make sure that we're at a good |
---|
83 | # breakpoint. If there's not a line break at the end of the |
---|
84 | # current output, then add the extra stuff onto a buffer |
---|
85 | # that we will merge in later once we get to a good point. |
---|
86 | # |
---|
87 | if {$execout(channel) == ""} { |
---|
88 | set execout(channel) $channel |
---|
89 | } |
---|
90 | |
---|
91 | set ready [expr {[string length $execout(output)] == 0 |
---|
92 | || [string index $execout(output) end] == "\n"}] |
---|
93 | |
---|
94 | if {$channel != $execout(channel)} { |
---|
95 | if {$ready} { |
---|
96 | # changing channels... |
---|
97 | if {[string length $execout(extra)] > 0} { |
---|
98 | # any extra stuff on this new channel? put it out now |
---|
99 | puts -nonewline $execout(extra) |
---|
100 | append execout(output) $execout(extra) |
---|
101 | set execout(extra) "" |
---|
102 | } |
---|
103 | puts -nonewline $message |
---|
104 | append execout(output) $message |
---|
105 | set execout(channel) $channel |
---|
106 | } else { |
---|
107 | # not ready to change channels -- keep this for later |
---|
108 | append execout(extra) $message |
---|
109 | } |
---|
110 | } else { |
---|
111 | # no need to change channels -- keep printing |
---|
112 | puts -nonewline $message |
---|
113 | append execout(output) $message |
---|
114 | } |
---|
115 | } |
---|