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

Last change on this file since 3551 was 3507, checked in by mmc, 11 years ago

Added SESSION to the run.xml file output, along with cputime and walltime
added previously. Fixed rptimes to normalize default values the same way
as current values, so you can tell when a run used a default value. Fixed
the processing of images in rptimes to treat width/height of the image as
separate parameters. They should be a better predictor of runtime than
the hash of the image data.

Fixed the Makefile for rpdiff and rptimes to look for them in the src
directory.
File size: 15.6 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: tool - represents an entire tool
4#
5#  This object represents an entire tool defined by Rappture.
6#  Each tool resides in an installation directory with other tool
7#  resources (libraries, examples, etc.).  Each tool is defined by
8#  its inputs and outputs, which are tied to various widgets in the
9#  GUI.  Each tool tracks the inputs, knows when they're changed,
10#  and knows how to run itself to produce new results.
11# ======================================================================
12#  AUTHOR:  Michael McLennan, Purdue University
13#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
14#
15#  See the file "license.terms" for information on usage and
16#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17# ======================================================================
18package require BLT
19
20itcl::class Rappture::Tool {
21    inherit Rappture::ControlOwner
22
23    constructor {xmlobj installdir args} {
24        Rappture::ControlOwner::constructor ""
25    } { # defined below }
26
27    destructor { # defined below }
28
29    public method installdir {} { return $_installdir }
30
31    public method run {args}
32    public method abort {}
33    public method reset {}
34
35    protected method _mkdir {dir}
36    protected method _output {data}
37
38    private variable _origxml ""     ;# copy of original XML (for reset)
39    private variable _installdir ""  ;# installation directory for this tool
40    private variable _outputcb ""    ;# callback for tool output
41    private common job               ;# array var used for blt::bgexec jobs
42    private common jobnum 0          ;# counter for unique job number
43
44    # get global resources for this tool session
45    public proc resources {{option ""}}
46
47    public common _resources
48    public proc setAppName {name}   { set _resources(-appname) $name }
49    public proc setHubName {name}   { set _resources(-hubname) $name }
50    public proc setHubURL {name}    { set _resources(-huburl) $name }
51    public proc setSession {name}   { set _resources(-session) $name }
52    public proc setJobPrt {name}    { set _resources(-jobprotocol) $name }
53    public proc setResultDir {name} { set _resources(-resultdir) $name }
54}
55
56# must use this name -- plugs into Rappture::resources::load
57proc tool_init_resources {} {
58    Rappture::resources::register \
59        application_name  Rappture::Tool::setAppName \
60        application_id    Rappture::Tool::setAppId \
61        hub_name          Rappture::Tool::setHubName \
62        hub_url           Rappture::Tool::setHubURL \
63        session_token     Rappture::Tool::setSession \
64        job_protocol      Rappture::Tool::setJobPrt \
65        results_directory Rappture::Tool::setResultDir
66}
67
68# ----------------------------------------------------------------------
69# CONSTRUCTOR
70# ----------------------------------------------------------------------
71itcl::body Rappture::Tool::constructor {xmlobj installdir args} {
72    if {![Rappture::library isvalid $xmlobj]} {
73        error "bad value \"$xmlobj\": should be Rappture::Library"
74    }
75    set _xmlobj $xmlobj
76
77    # stash a copy of the original XML for later "reset" operations
78    set _origxml [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run/>"]
79    $_origxml copy "" from $_xmlobj ""
80
81    if {![file exists $installdir]} {
82        error "directory \"$installdir\" doesn't exist"
83    }
84    set _installdir $installdir
85
86    eval configure $args
87}
88
89# ----------------------------------------------------------------------
90# DESTRUCTOR
91# ----------------------------------------------------------------------
92itcl::body Rappture::Tool::destructor {} {
93    itcl::delete object $_origxml
94}
95
96# ----------------------------------------------------------------------
97# USAGE: resources ?-option?
98#
99# Clients use this to query information about the tool.
100# ----------------------------------------------------------------------
101itcl::body Rappture::Tool::resources {{option ""}} {
102    if {$option == ""} {
103        return [array get _resources]
104    }
105    if {[info exists _resources($option)]} {
106        return $_resources($option)
107    }
108    return ""
109}
110
111# ----------------------------------------------------------------------
112# USAGE: run ?<path1> <value1> <path2> <value2> ...? ?-output <callbk>?
113#
114# This method causes the tool to run.  All widgets are synchronized
115# to the current XML representation, and a "driver.xml" file is
116# created as the input for the run.  That file is fed to the tool
117# according to the <tool><command> string, and the job is executed.
118#
119# Any "<path> <value>" arguments are used to override the current
120# settings from the GUI.  This is useful, for example, when filling
121# in missing simulation results from the analyzer.
122#
123# If the -output argument is included, then the next arg is a
124# callback command for output messages.  Any output that comes in
125# while the tool is running is sent back to the caller, so the user
126# can see progress running the tool.
127#
128# Returns a list of the form {status result}, where status is an
129# integer status code (0=success) and result is the output from the
130# simulator.  Successful output is something like {0 run1293921.xml},
131# where 0=success and run1293921.xml is the name of the file containing
132# results.
133# ----------------------------------------------------------------------
134itcl::body Rappture::Tool::run {args} {
135    global env errorInfo
136
137    #
138    # Make sure that we save the proper application name.
139    # Actually, the best place to get this information is
140    # straight from the "installtool" script, but just in
141    # case we have an older tool, we should insert the
142    # tool name from the resources config file.
143    #
144    if {[info exists _resources(-appname)]
145          && "" != $_resources(-appname)
146          && "" == [$_xmlobj get tool.name]} {
147        $_xmlobj put tool.name $_resources(-appname)
148    }
149
150    # sync all widgets to the XML tree
151    sync
152
153    # if there are any args, use them to override parameters
154    set _outputcb ""
155    foreach {path val} $args {
156        if {$path == "-output"} {
157            set _outputcb $val
158        } else {
159            $_xmlobj put $path.current $val
160        }
161    }
162
163    foreach item {control output error} { set job($item) "" }
164
165    # write out the driver.xml file for the tool
166    set file "driver[pid].xml"
167    set status [catch {
168        set fid [open $file w]
169        puts $fid "<?xml version=\"1.0\"?>"
170        puts $fid [$_xmlobj xml]
171        close $fid
172    } result]
173
174    # set limits for cpu time
175    set limit [$_xmlobj get tool.limits.cputime]
176    if {"" == $limit || [catch {Rappture::rlimit set cputime $limit}]} {
177        Rappture::rlimit set cputime 900  ;# 15 mins by default
178    }
179
180    # execute the tool using the path from the tool description
181    if {$status == 0} {
182        set cmd [$_xmlobj get tool.command]
183        regsub -all @tool $cmd $_installdir cmd
184        regsub -all @driver $cmd $file cmd
185        regsub -all {\\} $cmd {\\\\} cmd
186        set cmd [string trimleft $cmd " "]
187        if { $cmd == "" } {
188            puts stderr "cmd is empty"
189            return [list 1 "Command is empty.\n\nThere is no command specified by\n\n <command>\n </command>\n\nin the tool.xml file."]
190        }
191        # if job_protocol is "submit", then use use submit command
192        if {[resources -jobprotocol] == "submit"} {
193            set cmd [linsert $cmd 0 submit --local]
194        }
195        $_xmlobj put tool.execute $cmd
196
197        # starting job...
198        Rappture::Logger::log run started
199        Rappture::rusage mark
200
201        if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } {
202            set status 0;
203            set job(output) [string range $cmd 5 end]
204        } else {
205            set status [catch {
206                set ::Rappture::Tool::job(control) ""
207                eval blt::bgexec \
208                    ::Rappture::Tool::job(control) \
209                    -keepnewline yes \
210                    -killsignal SIGTERM \
211                    -onoutput [list [itcl::code $this _output]] \
212                    -output ::Rappture::Tool::job(output) \
213                    -error ::Rappture::Tool::job(error) \
214                    $cmd
215            } result]
216
217            if { $status != 0 } {
218                # We're here because the exec-ed program failed
219                set logmesg $result
220                if { $::Rappture::Tool::job(control) != "" } {
221                    foreach { token pid code mesg } \
222                        $::Rappture::Tool::job(control) break
223                    if { $token == "EXITED" } {
224                        # This means that the program exited normally but
225                        # returned a non-zero exitcode.  Consider this an
226                        # invalid result from the program.  Append the stderr
227                        # from the program to the message.
228                        set logmesg "Program finished: exit code is $code"
229                        set result "$logmesg\n\n$::Rappture::Tool::job(error)"
230                    } elseif { $token == "abort" }  {
231                        # The user pressed the abort button.
232                        set logmesg "Program terminated by user."
233                        set result "$logmesg\n\n$::Rappture::Tool::job(output)"
234                    } else {
235                        # Abnormal termination
236                        set logmesg "Abnormal program termination: $mesg"
237                        set result "$logmesg\n\n$::Rappture::Tool::job(output)"
238                    }
239                }
240                Rappture::Logger::log run failed [list $logmesg]
241                return [list $status $result]
242            }
243        }
244        # ...job is finished
245        array set times [Rappture::rusage measure]
246
247        if {[resources -jobprotocol] != "submit"} {
248            set id [$_xmlobj get tool.id]
249            set vers [$_xmlobj get tool.version.application.revision]
250            set simulation simulation
251            if { $id != "" && $vers != "" } {
252                set pid [pid]
253                set simulation ${pid}_${id}_r${vers}
254            }
255            puts stderr "MiddlewareTime: job=[incr jobnum] event=$simulation start=$times(start) walltime=$times(walltime) cputime=$times(cputime) status=$status"
256
257            #
258            # Scan through stderr channel and look for statements that
259            # represent grid jobs that were executed.  The statements
260            # look like this:
261            #
262            # MiddlewareTime: job=1 event=simulation start=3.001094 ...
263            #
264            set subjobs 0
265            while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} {
266                foreach {p0 p1} $match break
267                if {[string index $job(error) $p0] == "\n"} { incr p0 }
268
269                catch {unset data}
270                array set data {
271                    job 1
272                    event simulation
273                    start 0
274                    walltime 0
275                    cputime 0
276                    status 0
277                }
278                foreach arg [lrange [string range $job(error) $p0 $p1] 1 end] {
279                    foreach {key val} [split $arg =] break
280                    set data($key) $val
281                }
282                set data(job) [expr {$jobnum+$data(job)}]
283                set data(event) "subsimulation"
284                set data(start) [expr {$times(start)+$data(start)}]
285
286                set stmt "MiddlewareTime:"
287                foreach key {job event start walltime cputime status} {
288                    # add required keys in a particular order
289                    append stmt " $key=$data($key)"
290                    unset data($key)
291                }
292                foreach key [array names data] {
293                    # add anything else that the client gave -- venue, etc.
294                    append stmt " $key=$data($key)"
295                }
296                puts stderr $stmt
297                incr subjobs
298
299                # done -- remove this statement
300                set job(error) [string replace $job(error) $p0 $p1]
301            }
302            incr jobnum $subjobs
303        }
304
305    } else {
306        set job(error) "$result\n$errorInfo"
307    }
308    if {$status == 0} {
309        file delete -force -- $file
310    }
311
312    # see if the job was aborted
313    if {[regexp {^KILLED} $job(control)]} {
314        Rappture::Logger::log run aborted
315        return [list 0 "ABORT"]
316    }
317
318    #
319    # If successful, return the output, which should include
320    # a reference to the run.xml file containing results.
321    #
322    if {$status == 0} {
323        set result [string trim $job(output)]
324        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
325            set status [catch {Rappture::library $file} result]
326            if {$status == 0} {
327                # add cputime info to run.xml file
328                $result put output.walltime $times(walltime)
329                $result put output.cputime $times(cputime)
330                if {[info exists env(SESSION)]} {
331                    $result put output.session $env(SESSION)
332                }
333            } else {
334                global errorInfo
335                set result "$result\n$errorInfo"
336            }
337
338            # if there's a results_directory defined in the resources
339            # file, then move the run.xml file there for storage
340            if {$status == 0 && [info exists _resources(-resultdir)]
341                  && $_resources(-resultdir) ne ""} {
342                catch {
343                    if {![file exists $_resources(-resultdir)]} {
344                        _mkdir $_resources(-resultdir)
345                    }
346                    set tail [file tail $file]
347                    set fid [open [file join $_resources(-resultdir) $tail] w]
348                    puts $fid "<?xml version=\"1.0\"?>"
349                    puts $fid [$result xml]
350                    close $fid
351                    file delete -force -- $file
352                }
353            }
354        } else {
355            set status 1
356            set result "Can't find result file in output.\nDid you call Rappture
357::result in your simulator?"
358        }
359    } elseif {$job(output) ne "" || $job(error) ne ""} {
360        set result [string trim "$job(output)\n$job(error)"]
361    }
362
363    # log final status for the run
364    if {$status == 0} {
365        Rappture::Logger::log run finished
366    } else {
367        Rappture::Logger::log run failed [list $result]
368    }
369
370    return [list $status $result]
371}
372
373# ----------------------------------------------------------------------
374# USAGE: _mkdir <directory>
375#
376# Used internally to create the <directory> in the file system.
377# The parent directory is also created, as needed.
378# ----------------------------------------------------------------------
379itcl::body Rappture::Tool::_mkdir {dir} {
380    set parent [file dirname $dir]
381    if {"." != $parent && "/" != $parent} {
382        if {![file exists $parent]} {
383            _mkdir $parent
384        }
385    }
386    file mkdir $dir
387}
388
389
390# ----------------------------------------------------------------------
391# USAGE: abort
392#
393# Clients use this during a "run" to abort the current job.
394# Kills the job and forces the "run" method to return.
395# ----------------------------------------------------------------------
396itcl::body Rappture::Tool::abort {} {
397    Rappture::Logger::log run abort
398    set job(control) "abort"
399}
400
401# ----------------------------------------------------------------------
402# USAGE: reset
403#
404# Resets all input values to their defaults.  Sometimes used just
405# before a run to reset to a clean state.
406# ----------------------------------------------------------------------
407itcl::body Rappture::Tool::reset {} {
408    $_xmlobj copy "" from $_origxml ""
409    foreach path [Rappture::entities -as path $_xmlobj input] {
410        if {[$_xmlobj element -as type $path.default] ne ""} {
411            set defval [$_xmlobj get $path.default]
412            $_xmlobj put $path.current $defval
413        }
414    }
415}
416
417# ----------------------------------------------------------------------
418# USAGE: _output <data>
419#
420# Used internally to send each bit of output <data> coming from the
421# tool onto the caller, so the user can see progress.
422# ----------------------------------------------------------------------
423itcl::body Rappture::Tool::_output {data} {
424    if {[string length $_outputcb] > 0} {
425        uplevel #0 $_outputcb [list $data]
426    }
427}
Note: See TracBrowser for help on using the repository browser.