Changeset 4127
- Timestamp:
- Jan 16, 2014, 10:51:33 AM (11 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 7 edited
- 1 moved
-
gui/apps/launcher.tcl (modified) (5 diffs)
-
gui/apps/rappture.in (modified) (1 diff)
-
gui/scripts/Makefile.in (modified) (1 diff)
-
gui/scripts/tool.tcl (modified) (4 diffs)
-
lang/tcl/scripts/Makefile.in (modified) (1 diff)
-
lang/tcl/scripts/resources.tcl (moved) (moved from trunk/gui/scripts/resources.tcl)
-
lang/tcl/scripts/task.tcl (added)
-
tester/scripts/Makefile.in (modified) (1 diff)
-
tester/scripts/auto.tcl (added)
-
tester/scripts/main.tcl (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/apps/launcher.tcl
r3177 r4127 24 24 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 25 25 # ====================================================================== 26 package require RapptureGUI 27 set guidir $RapptureGUI::library 28 29 package require RapptureBuilder 30 set blddir $RapptureBuilder::library 31 32 package require RapptureTester 33 set testdir $RapptureTester::library 34 35 set mainscript [file join $guidir scripts main.tcl] 26 set mainscript "" 36 27 set alist "" 37 28 set toolxml "" … … 45 36 switch -- $opt { 46 37 -run { 38 package require RapptureGUI 39 set guidir $RapptureGUI::library 47 40 set mainscript [file join $guidir scripts main.tcl] 41 set reqpkgs Tk 48 42 } 49 43 -builder { 44 package require RapptureBuilder 45 set blddir $RapptureBuilder::library 50 46 set mainscript [file join $blddir scripts main.tcl] 47 set reqpkgs Tk 51 48 } 52 49 -tester { 50 package require RapptureTester 51 set testdir $RapptureTester::library 53 52 set mainscript [file join $testdir scripts main.tcl] 53 set reqpkgs Tk 54 54 } 55 55 -tool { … … 65 65 lappend alist $opt [lindex $argv 0] 66 66 set argv [lrange $argv 1 end] 67 } 68 -auto { 69 # for the tester in automatic mode -- don't load Tk 70 package require RapptureTester 71 set testdir $RapptureTester::library 72 set mainscript [file join $testdir scripts auto.tcl] 73 set reqpkgs "" 67 74 } 68 75 -load { … … 81 88 puts stderr " rappture ?-run? ?-tool toolFile? ?-nosim 0/1? ?-load file file ...?" 82 89 puts stderr " rappture -builder ?-tool toolFile?" 83 puts stderr " rappture -tester ?- tool toolFile? ?-testdir directory?"90 puts stderr " rappture -tester ?-auto? ?-tool toolFile? ?-testdir directory?" 84 91 exit 1 85 92 } 86 93 } 87 94 } 95 } 96 97 # If no arguments, assume that it's the -run option 98 if {$mainscript eq ""} { 99 package require RapptureGUI 100 set guidir $RapptureGUI::library 101 set mainscript [file join $guidir scripts main.tcl] 102 set reqpkgs Tk 88 103 } 89 104 … … 97 112 # blt::bgexec. It doesn't try to redirect stderr into a file. 98 113 set argv $alist 99 package require Tk 114 foreach name $reqpkgs { 115 package require $name 116 } 100 117 source $mainscript -
trunk/gui/apps/rappture.in
r3177 r4127 16 16 dir=`dirname $0` 17 17 . $dir/rappture.env 18 exec tclsh $dir/launcher.tcl --"$@"18 exec tclsh $dir/launcher.tcl "$@" -
trunk/gui/scripts/Makefile.in
r4012 r4127 98 98 $(srcdir)/pushbutton.tcl \ 99 99 $(srcdir)/radiodial.tcl \ 100 $(srcdir)/resources.tcl \101 100 $(srcdir)/resultset.tcl \ 102 101 $(srcdir)/resultselector.tcl \ -
trunk/gui/scripts/tool.tcl
r3811 r4127 11 11 # ====================================================================== 12 12 # AUTHOR: Michael McLennan, Purdue University 13 # Copyright (c) 2004-201 2HUBzero Foundation, LLC13 # Copyright (c) 2004-2014 HUBzero Foundation, LLC 14 14 # 15 15 # See the file "license.terms" for information on usage and 16 16 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 17 17 # ====================================================================== 18 package require BLT19 18 20 19 itcl::class Rappture::Tool { 21 20 inherit Rappture::ControlOwner 22 21 23 constructor {xmlobj installdir args} {22 constructor {xmlobj installdir} { 24 23 Rappture::ControlOwner::constructor "" 25 24 } { # defined below } … … 27 26 destructor { # defined below } 28 27 29 public method installdir {} { return $_installdir } 28 public method installdir {} { 29 return [$_task installdir] 30 } 31 public method run {args} { 32 sync ;# sync all widget values to XML 33 eval $_task run $args 34 } 35 public method abort {} { 36 $_task abort 37 } 38 public method reset {} { 39 $_task reset 40 } 30 41 31 public method run {args} 32 public method abort {} 33 public method reset {} 42 private variable _task "" ;# underlying task for the tool 34 43 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 57 proc 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 44 # global resources for this tool session (from task) 45 public proc resources {{option ""}} { 46 eval ::Rappture::Task::resources $option 47 } 66 48 } 67 49 … … 69 51 # CONSTRUCTOR 70 52 # ---------------------------------------------------------------------- 71 itcl::body Rappture::Tool::constructor {xmlobj installdir args} {53 itcl::body Rappture::Tool::constructor {xmlobj installdir} { 72 54 if {![Rappture::library isvalid $xmlobj]} { 73 55 error "bad value \"$xmlobj\": should be Rappture::Library" 74 56 } 57 58 set _task [Rappture::Task ::#auto $xmlobj $installdir \ 59 -logger ::Rappture::Logger::log] 60 61 # save a reference to the tool XML in the ControlOwner 75 62 set _xmlobj $xmlobj 76 77 # stash a copy of the original XML for later "reset" operations78 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 $installdir85 86 eval configure $args87 63 } 88 64 … … 91 67 # ---------------------------------------------------------------------- 92 68 itcl::body Rappture::Tool::destructor {} { 93 itcl::delete object $_ origxml69 itcl::delete object $_task 94 70 } 95 96 # ----------------------------------------------------------------------97 # USAGE: resources ?-option?98 #99 # Clients use this to query information about the tool.100 # ----------------------------------------------------------------------101 itcl::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 synchronized115 # to the current XML representation, and a "driver.xml" file is116 # created as the input for the run. That file is fed to the tool117 # according to the <tool><command> string, and the job is executed.118 #119 # Any "<path> <value>" arguments are used to override the current120 # settings from the GUI. This is useful, for example, when filling121 # in missing simulation results from the analyzer.122 #123 # If the -output argument is included, then the next arg is a124 # callback command for output messages. Any output that comes in125 # while the tool is running is sent back to the caller, so the user126 # can see progress running the tool.127 #128 # Returns a list of the form {status result}, where status is an129 # integer status code (0=success) and result is the output from the130 # simulator. Successful output is something like {0 run1293921.xml},131 # where 0=success and run1293921.xml is the name of the file containing132 # results.133 # ----------------------------------------------------------------------134 itcl::body Rappture::Tool::run {args} {135 global env errorInfo136 137 #138 # Make sure that we save the proper application name.139 # Actually, the best place to get this information is140 # straight from the "installtool" script, but just in141 # case we have an older tool, we should insert the142 # 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 tree151 sync152 153 # if there are any args, use them to override parameters154 set _outputcb ""155 foreach {path val} $args {156 if {$path == "-output"} {157 set _outputcb $val158 } else {159 $_xmlobj put $path.current $val160 }161 }162 163 foreach item {control output error} { set job($item) "" }164 165 # write out the driver.xml file for the tool166 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 $fid172 } result]173 174 # Set limits for cpu time175 set limit [$_xmlobj get tool.limits.cputime]176 if { $limit == "unlimited" } {177 set limit 43200; # 12 hours178 } else {179 if { [scan $limit "%d" dum] != 1 } {180 set limit 14400; # 4 hours by default181 } elseif { $limit > 43200 } {182 set limit 43200; # limit to 12 hrs.183 } elseif { $limit < 10 } {184 set limit 10; # lower bound is 10 seconds.185 }186 }187 Rappture::rlimit set cputime $limit188 # execute the tool using the path from the tool description189 if {$status == 0} {190 set cmd [$_xmlobj get tool.command]191 regsub -all @tool $cmd $_installdir cmd192 regsub -all @driver $cmd $file cmd193 regsub -all {\\} $cmd {\\\\} cmd194 set cmd [string trimleft $cmd " "]195 if { $cmd == "" } {196 puts stderr "cmd is empty"197 return [list 1 "Command is empty.\n\nThere is no command specified by\n\n <command>\n </command>\n\nin the tool.xml file."]198 }199 # if job_protocol is "submit", then use use submit command200 if {[resources -jobprotocol] == "submit"} {201 set cmd [linsert $cmd 0 submit --local]202 }203 $_xmlobj put tool.execute $cmd204 205 # starting job...206 Rappture::Logger::log run started207 Rappture::rusage mark208 209 if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } {210 set status 0;211 set job(output) [string range $cmd 5 end]212 } else {213 set status [catch {214 set ::Rappture::Tool::job(control) ""215 eval blt::bgexec \216 ::Rappture::Tool::job(control) \217 -keepnewline yes \218 -killsignal SIGTERM \219 -onoutput [list [itcl::code $this _output]] \220 -output ::Rappture::Tool::job(output) \221 -error ::Rappture::Tool::job(error) \222 $cmd223 } result]224 225 if { $status != 0 } {226 # We're here because the exec-ed program failed227 set logmesg $result228 if { $::Rappture::Tool::job(control) != "" } {229 foreach { token pid code mesg } \230 $::Rappture::Tool::job(control) break231 if { $token == "EXITED" } {232 # This means that the program exited normally but233 # returned a non-zero exitcode. Consider this an234 # invalid result from the program. Append the stderr235 # from the program to the message.236 set logmesg "Program finished: exit code is $code"237 set result "$logmesg\n\n$::Rappture::Tool::job(error)"238 } elseif { $token == "abort" } {239 # The user pressed the abort button.240 set logmesg "Program terminated by user."241 set result "$logmesg\n\n$::Rappture::Tool::job(output)"242 } else {243 # Abnormal termination244 set logmesg "Abnormal program termination: $mesg"245 set result "$logmesg\n\n$::Rappture::Tool::job(output)"246 }247 }248 Rappture::Logger::log run failed [list $logmesg]249 return [list $status $result]250 }251 }252 # ...job is finished253 array set times [Rappture::rusage measure]254 255 if {[resources -jobprotocol] != "submit"} {256 set id [$_xmlobj get tool.id]257 set vers [$_xmlobj get tool.version.application.revision]258 set simulation simulation259 if { $id != "" && $vers != "" } {260 set pid [pid]261 set simulation ${pid}_${id}_r${vers}262 }263 puts stderr "MiddlewareTime: job=[incr jobnum] event=$simulation start=$times(start) walltime=$times(walltime) cputime=$times(cputime) status=$status"264 265 #266 # Scan through stderr channel and look for statements that267 # represent grid jobs that were executed. The statements268 # look like this:269 #270 # MiddlewareTime: job=1 event=simulation start=3.001094 ...271 #272 set subjobs 0273 while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} {274 foreach {p0 p1} $match break275 if {[string index $job(error) $p0] == "\n"} { incr p0 }276 277 catch {unset data}278 array set data {279 job 1280 event simulation281 start 0282 walltime 0283 cputime 0284 status 0285 }286 foreach arg [lrange [string range $job(error) $p0 $p1] 1 end] {287 foreach {key val} [split $arg =] break288 set data($key) $val289 }290 set data(job) [expr {$jobnum+$data(job)}]291 set data(event) "subsimulation"292 set data(start) [expr {$times(start)+$data(start)}]293 294 set stmt "MiddlewareTime:"295 foreach key {job event start walltime cputime status} {296 # add required keys in a particular order297 append stmt " $key=$data($key)"298 unset data($key)299 }300 foreach key [array names data] {301 # add anything else that the client gave -- venue, etc.302 append stmt " $key=$data($key)"303 }304 puts stderr $stmt305 incr subjobs306 307 # done -- remove this statement308 set job(error) [string replace $job(error) $p0 $p1]309 }310 incr jobnum $subjobs311 }312 313 } else {314 set job(error) "$result\n$errorInfo"315 }316 if {$status == 0} {317 file delete -force -- $file318 }319 320 # see if the job was aborted321 if {[regexp {^KILLED} $job(control)]} {322 Rappture::Logger::log run aborted323 return [list 0 "ABORT"]324 }325 326 #327 # If successful, return the output, which should include328 # a reference to the run.xml file containing results.329 #330 if {$status == 0} {331 set result [string trim $job(output)]332 if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {333 set status [catch {Rappture::library $file} result]334 if {$status == 0} {335 # add cputime info to run.xml file336 $result put output.walltime $times(walltime)337 $result put output.cputime $times(cputime)338 if {[info exists env(SESSION)]} {339 $result put output.session $env(SESSION)340 }341 } else {342 global errorInfo343 set result "$result\n$errorInfo"344 }345 346 # if there's a results_directory defined in the resources347 # file, then move the run.xml file there for storage348 if {$status == 0 && [info exists _resources(-resultdir)]349 && $_resources(-resultdir) ne ""} {350 catch {351 if {![file exists $_resources(-resultdir)]} {352 _mkdir $_resources(-resultdir)353 }354 set tail [file tail $file]355 set fid [open [file join $_resources(-resultdir) $tail] w]356 puts $fid "<?xml version=\"1.0\"?>"357 puts $fid [$result xml]358 close $fid359 file delete -force -- $file360 }361 }362 } else {363 set status 1364 set result "Can't find result file in output.\nDid you call Rappture365 ::result in your simulator?"366 }367 } elseif {$job(output) ne "" || $job(error) ne ""} {368 set result [string trim "$job(output)\n$job(error)"]369 }370 371 # log final status for the run372 if {$status == 0} {373 Rappture::Logger::log run finished374 } else {375 Rappture::Logger::log run failed [list $result]376 }377 378 return [list $status $result]379 }380 381 # ----------------------------------------------------------------------382 # USAGE: _mkdir <directory>383 #384 # Used internally to create the <directory> in the file system.385 # The parent directory is also created, as needed.386 # ----------------------------------------------------------------------387 itcl::body Rappture::Tool::_mkdir {dir} {388 set parent [file dirname $dir]389 if {"." != $parent && "/" != $parent} {390 if {![file exists $parent]} {391 _mkdir $parent392 }393 }394 file mkdir $dir395 }396 397 398 # ----------------------------------------------------------------------399 # USAGE: abort400 #401 # Clients use this during a "run" to abort the current job.402 # Kills the job and forces the "run" method to return.403 # ----------------------------------------------------------------------404 itcl::body Rappture::Tool::abort {} {405 Rappture::Logger::log run abort406 set job(control) "abort"407 }408 409 # ----------------------------------------------------------------------410 # USAGE: reset411 #412 # Resets all input values to their defaults. Sometimes used just413 # before a run to reset to a clean state.414 # ----------------------------------------------------------------------415 itcl::body Rappture::Tool::reset {} {416 $_xmlobj copy "" from $_origxml ""417 foreach path [Rappture::entities -as path $_xmlobj input] {418 if {[$_xmlobj element -as type $path.default] ne ""} {419 set defval [$_xmlobj get $path.default]420 $_xmlobj put $path.current $defval421 }422 }423 }424 425 # ----------------------------------------------------------------------426 # USAGE: _output <data>427 #428 # Used internally to send each bit of output <data> coming from the429 # tool onto the caller, so the user can see progress.430 # ----------------------------------------------------------------------431 itcl::body Rappture::Tool::_output {data} {432 if {[string length $_outputcb] > 0} {433 uplevel #0 $_outputcb [list $data]434 }435 } -
trunk/lang/tcl/scripts/Makefile.in
r3056 r4127 43 43 $(srcdir)/library.tcl \ 44 44 $(srcdir)/objects.tcl \ 45 $(srcdir)/resources.tcl \ 45 46 $(srcdir)/result.tcl \ 47 $(srcdir)/task.tcl \ 46 48 $(srcdir)/units.tcl 47 49 -
trunk/tester/scripts/Makefile.in
r3471 r4127 18 18 19 19 FILES = \ 20 $(srcdir)/auto.tcl \ 20 21 $(srcdir)/main.tcl \ 21 22 $(srcdir)/legend.tcl \ -
trunk/tester/scripts/main.tcl
r3177 r4127 17 17 # USAGE: tester.tcl ?-tool tool.xml? ?-testdir tests? 18 18 # ====================================================================== 19 # AUTHOR :Ben Rafferty, Purdue University19 # AUTHORS: Michael McLennan, Ben Rafferty, Purdue University 20 20 # Copyright (c) 2004-2012 HUBzero Foundation, LLC 21 21 # … … 136 136 set installdir [file dirname [file normalize $params(-tool)]] 137 137 set xmlobj [Rappture::library $params(-tool)] 138 set ToolObj [Rappture::Tool ::#auto $xmlobj $installdir] 138 set TaskObj [Rappture::Task ::#auto $xmlobj $installdir] 139 140 # tasks in the tester run quietly and discard results 141 $TaskObj configure -jobstats "" -resultdir "" 142 139 143 set DiffShow "" ;# used to track which diff objects are being displayed 140 144 … … 296 300 set testtree [.pw pane 0].tree 297 301 foreach file [glob -nocomplain -directory $params(-testdir) *.xml] { 298 set testobj [Rappture::Tester::Test ::#auto $T oolObj $file]302 set testobj [Rappture::Tester::Test ::#auto $TaskObj $file] 299 303 if {[$testobj getTestInfo test.label] eq ""} { 300 304 puts stderr "ERROR: Missing test label in $file"
Note: See TracChangeset
for help on using the changeset viewer.
