source: trunk/gui/scripts/tool.tcl @ 775

Last change on this file since 775 was 775, checked in by dkearney, 15 years ago

removed the hard coded path to submit per steve's request.
now, on nanohub, rappture applications should find submit through a correctly loaded environment.

File size: 10.8 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: tool - represents an entire tool
3#
4#  This object represents an entire tool defined by Rappture.
5#  Each tool resides in an installation directory with other tool
6#  resources (libraries, examples, etc.).  Each tool is defined by
7#  its inputs and outputs, which are tied to various widgets in the
8#  GUI.  Each tool tracks the inputs, knows when they're changed,
9#  and knows how to run itself to produce new results.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2005  Purdue Research Foundation
13#
14#  See the file "license.terms" for information on usage and
15#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require BLT
18
19itcl::class Rappture::Tool {
20    inherit Rappture::ControlOwner
21
22    constructor {xmlobj installdir args} {
23        Rappture::ControlOwner::constructor ""
24    } { # defined below }
25
26    public method installdir {} { return $_installdir }
27
28    public method run {args}
29    public method abort {}
30
31    protected method _output {data}
32
33    private variable _installdir ""  ;# installation directory for this tool
34    private variable _outputcb ""    ;# callback for tool output
35    private common job               ;# array var used for blt::bgexec jobs
36    private common jobnum 0          ;# counter for unique job number
37
38    # get global resources for this tool session
39    public proc resources {{option ""}}
40
41    public common _resources
42    public proc setAppName {name} { set _resources(-appname) $name }
43    public proc setHubName {name} { set _resources(-hubname) $name }
44    public proc setHubURL {name}  { set _resources(-huburl) $name }
45    public proc setSession {name} { set _resources(-session) $name }
46    public proc setJobPrt {name}  { set _resources(-jobprotocol) $name }
47}
48
49# must use this name -- plugs into Rappture::resources::load
50proc tool_init_resources {} {
51    Rappture::resources::register \
52        application_name Rappture::Tool::setAppName \
53        application_id   Rappture::Tool::setAppId \
54        hub_name         Rappture::Tool::setHubName \
55        hub_url          Rappture::Tool::setHubURL \
56        session_token    Rappture::Tool::setSession \
57        job_protocol     Rappture::Tool::setJobPrt
58}
59                                                                               
60# ----------------------------------------------------------------------
61# CONSTRUCTOR
62# ----------------------------------------------------------------------
63itcl::body Rappture::Tool::constructor {xmlobj installdir args} {
64    if {![Rappture::library isvalid $xmlobj]} {
65        error "bad value \"$xmlobj\": should be Rappture::Library"
66    }
67    set _xmlobj $xmlobj
68
69    if {![file exists $installdir]} {
70        error "directory \"$installdir\" doesn't exist"
71    }
72    set _installdir $installdir
73
74    eval configure $args
75}
76
77# ----------------------------------------------------------------------
78# USAGE: resources ?-option?
79#
80# Clients use this to query information about the tool.
81# ----------------------------------------------------------------------
82itcl::body Rappture::Tool::resources {{option ""}} {
83    if {$option == ""} {
84        return [array get _resources]
85    }
86    if {[info exists _resources($option)]} {
87        return $_resources($option)
88    }
89    return ""
90}
91
92# ----------------------------------------------------------------------
93# USAGE: run ?<path1> <value1> <path2> <value2> ...? ?-output <callbk>?
94#
95# This method causes the tool to run.  All widgets are synchronized
96# to the current XML representation, and a "driver.xml" file is
97# created as the input for the run.  That file is fed to the tool
98# according to the <tool><command> string, and the job is executed.
99#
100# Any "<path> <value>" arguments are used to override the current
101# settings from the GUI.  This is useful, for example, when filling
102# in missing simulation results from the analyzer.
103#
104# If the -output argument is included, then the next arg is a
105# callback command for output messages.  Any output that comes in
106# while the tool is running is sent back to the caller, so the user
107# can see progress running the tool.
108#
109# Returns a list of the form {status result}, where status is an
110# integer status code (0=success) and result is the output from the
111# simulator.  Successful output is something like {0 run1293921.xml},
112# where 0=success and run1293921.xml is the name of the file containing
113# results.
114# ----------------------------------------------------------------------
115itcl::body Rappture::Tool::run {args} {
116    global errorInfo
117
118    #
119    # Make sure that we save the proper application name.
120    # Actually, the best place to get this information is
121    # straight from the "installtool" script, but just in
122    # case we have an older tool, we should insert the
123    # tool name from the resources config file.
124    #
125    if {[info exists _resources(-appname)]
126          && "" != $_resources(-appname)
127          && "" == [$_xmlobj get tool.name]} {
128        $_xmlobj put tool.name $_resources(-appname)
129    }
130
131    # sync all widgets to the XML tree
132    sync
133
134    # if there are any args, use them to override parameters
135    set _outputcb ""
136    foreach {path val} $args {
137        if {$path == "-output"} {
138            set _outputcb $val
139        } else {
140            $_xmlobj put $path.current $val
141        }
142    }
143
144    foreach item {control output error} { set job($item) "" }
145
146    # write out the driver.xml file for the tool
147    set file "driver[pid].xml"
148    set status [catch {
149        set fid [open $file w]
150        puts $fid "<?xml version=\"1.0\"?>"
151        puts $fid [$_xmlobj xml]
152        close $fid
153    } result]
154
155    # set limits for cpu time and file size
156    set limit [$_xmlobj get tool.limits.cputime]
157    if {"" == $limit || [catch {Rappture::rlimit set cputime $limit}]} {
158        Rappture::rlimit set cputime 900  ;# 15 mins by default
159    }
160
161    set limit [$_xmlobj get tool.limits.filesize]
162    if {"" == $limit || [catch {Rappture::rlimit set filesize $limit}]} {
163        Rappture::rlimit set filesize 1000000  ;# 1MB by default
164    }
165
166    # execute the tool using the path from the tool description
167    if {$status == 0} {
168        set cmd [$_xmlobj get tool.command]
169        regsub -all @tool $cmd $_installdir cmd
170        regsub -all @driver $cmd $file cmd
171        regsub -all {\\} $cmd {\\\\} cmd
172        set cmd [string trimleft $cmd " "]
173
174        # if job_protocol is "submit", then use use submit command
175        if {[resources -jobprotocol] == "submit"} {
176            set cmd [linsert $cmd 0 submit --local]
177        }
178
179        # starting job...
180        Rappture::rusage mark
181
182        if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } {
183            set status 0;
184            set job(output) [string range $cmd 5 end]
185        } else {
186            set status [catch {eval blt::bgexec \
187                ::Rappture::Tool::job(control) \
188                -keepnewline yes \
189                -killsignal SIGTERM \
190                -onoutput [list [itcl::code $this _output]] \
191                -output ::Rappture::Tool::job(output) \
192                -error ::Rappture::Tool::job(error) $cmd} result]
193        }
194        # ...job is finished
195        array set times [Rappture::rusage measure]
196
197        if {[resources -jobprotocol] != "submit"} {
198            puts stderr "MiddlewareTime: job=[incr jobnum] event=simulation start=$times(start) walltime=$times(walltime) cputime=$times(cputime) status=$status"
199
200            #
201            # Scan through stderr channel and look for statements that
202            # represent grid jobs that were executed.  The statements
203            # look like this:
204            #
205            # MiddlewareTime: job=1 event=simulation start=3.001094 ...
206            #
207            set subjobs 0
208            while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} {
209                foreach {p0 p1} $match break
210                if {[string index $job(error) $p0] == "\n"} { incr p0 }
211
212                catch {unset data}
213                array set data {
214                    job 1
215                    event simulation
216                    start 0
217                    walltime 0
218                    cputime 0
219                    status 0
220                }
221                foreach arg [lrange [string range $job(error) $p0 $p1] 1 end] {
222                    foreach {key val} [split $arg =] break
223                    set data($key) $val
224                }
225                set data(job) [expr {$jobnum+$data(job)}]
226                set data(event) "subsimulation"
227                set data(start) [expr {$times(start)+$data(start)}]
228
229                set stmt "MiddlewareTime:"
230                foreach key {job event start walltime cputime status} {
231                    # add required keys in a particular order
232                    append stmt " $key=$data($key)"
233                    unset data($key)
234                }
235                foreach key [array names data] {
236                    # add anything else that the client gave -- venue, etc.
237                    append stmt " $key=$data($key)"
238                }
239                puts stderr $stmt
240                incr subjobs
241
242                # done -- remove this statement
243                set job(error) [string replace $job(error) $p0 $p1]
244            }
245            incr jobnum $subjobs
246        }
247
248    } else {
249        set job(error) "$result\n$errorInfo"
250    }
251    if {$status == 0} {
252        file delete -force -- $file
253    }
254
255    # see if the job was aborted
256    if {[regexp {^KILLED} $job(control)]} {
257        return [list 0 "ABORT"]
258    }
259
260    #
261    # If successful, return the output, which should include
262    # a reference to the run.xml file containing results.
263    #
264    if {$status == 0} {
265        set file [string trim $job(output)]
266        return [list $status $file]
267    } elseif {"" != $job(output) || "" != $job(error)} {
268        return [list $status [string trim "$job(output)\n$job(error)"]]
269    }
270    return [list $status $result]
271}
272
273# ----------------------------------------------------------------------
274# USAGE: abort
275#
276# Clients use this during a "run" to abort the current job.
277# Kills the job and forces the "run" method to return.
278# ----------------------------------------------------------------------
279itcl::body Rappture::Tool::abort {} {
280    set job(control) "abort"
281}
282
283# ----------------------------------------------------------------------
284# USAGE: _output <data>
285#
286# Used internally to send each bit of output <data> coming from the
287# tool onto the caller, so the user can see progress.
288# ----------------------------------------------------------------------
289itcl::body Rappture::Tool::_output {data} {
290    if {[string length $_outputcb] > 0} {
291        uplevel #0 [list $_outputcb $data]
292    }
293}
Note: See TracBrowser for help on using the repository browser.