source: trunk/gui/scripts/exec.tcl @ 158

Last change on this file since 158 was 158, checked in by mmc, 18 years ago
  • Fixed installation so that this "gui" part can be installed with standard autoconf techniques: configure, make all, make install The "gui" library is loaded via "package require RapptureGUI"
  • Added C code for Rappture::rlimit, to support limits on CPU time and file sizes. Default limits are 15 mins of CPU and 1MB for each file. These can be overridden in tool.xml by using <tool><limits><cputime> and <tool><limits><filesize>.
  • Added C code for Rappture::rusage, so we can collect resource usage for all child processes. Each Simulation now reports a line of usage to stderr as follows:

MiddlewareTime?: job=# event=simulation start=xxx cputime=xxx ...

  • Fixed Rappture::exec so that it reports proper error messages when rlimits are execeeded.
File size: 4.1 KB
Line 
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# ======================================================================
15package require BLT
16
17namespace 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# ----------------------------------------------------------------------
28proc Rappture::exec {args} {
29    variable execout
30    variable execctl
31
32    set execout(output) ""
33    set execout(channel) ""
34    set execout(extra) ""
35
36    set status [catch {eval blt::bgexec ::Rappture::execctl \
37        -keepnewline yes \
38        -onoutput {{::Rappture::_exec_out stdout}} \
39        -onerror {{::Rappture::_exec_out stderr}} \
40        $args} result]
41
42    # add any extra stuff pending from the last stdout/stderr change
43    append execout(output) $execout(extra)
44
45    if {$status != 0} {
46        if {[regexp {^KILLED} $execctl] && [llength $execctl] == 4} {
47            set reason [lindex $execctl end]
48            set result "job killed: $reason"
49        }
50        error $result
51    }
52    return $execout(output)
53}
54
55# ----------------------------------------------------------------------
56# USAGE: _exec_out <channel> <message>
57#
58# Called automatically whenever output comes in from the Rappture::exec
59# utility.  Streams the output to stdout and adds it to the "execout"
60# variable, so it can be returned as one large string at the end of
61# the exec.
62# ----------------------------------------------------------------------
63proc Rappture::_exec_out {channel message} {
64    variable execout
65
66    #
67    # If this message is being written to the stderr channel, then
68    # add the =RAPPTURE-ERROR=> prefix to each line.
69    #
70    if {$channel == "stderr"} {
71        set newmesg ""
72        foreach line [split $message \n] {
73            append newmesg "=RAPPTURE-ERROR=>$line\n"
74        }
75        set message $newmesg
76    }
77
78    #
79    # If this message is coming in on the same channel as the
80    # last, then fine, add it on.  But if it's coming in on a
81    # different channel, we must make sure that we're at a good
82    # breakpoint.  If there's not a line break at the end of the
83    # current output, then add the extra stuff onto a buffer
84    # that we will merge in later once we get to a good point.
85    #
86    if {$execout(channel) == ""} {
87        set execout(channel) $channel
88    }
89
90    set ready [expr {[string length $execout(output)] == 0
91        || [string index $execout(output) end] == "\n"}]
92
93    if {$channel != $execout(channel)} {
94        if {$ready} {
95            # changing channels...
96            if {[string length $execout(extra)] > 0} {
97                # any extra stuff on this new channel? put it out now
98                puts -nonewline $execout(extra)
99                append execout(output) $execout(extra)
100                set execout(extra) ""
101            }
102            puts -nonewline $message
103            append execout(output) $message
104            set execout(channel) $channel
105        } else {
106            # not ready to change channels -- keep this for later
107            append execout(extra) $message
108        }
109    } else {
110        # no need to change channels -- keep printing
111        puts -nonewline $message
112        append execout(output) $message
113    }
114}
Note: See TracBrowser for help on using the repository browser.