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

Last change on this file since 903 was 903, checked in by mmc, 15 years ago

Final tweaks on the optimization package. The demo now works properly.
Just run "wish simple.tcl" to see it work.

Fixed the Tool class to work better with the optimizer. The "run"
method now returns the result directly as a Rappture::Library object,
and the Analyzer merely loads the object.

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