gmevallog.tcl

来自「算断裂的」· TCL 代码 · 共 58 行

proc gmevallog {ifilename {ofilename ""}} {
    # gmevallog <infilename> {<outfilename>}
    # Evaluates the script in <infilename> and writes a log
    # of commands and their results in outfile, or stdout.
    
    set ifile [open $ifilename r]
    if {$ofilename == ""} {
	set ofile stdout
    } else {
	set ofile [open $ofilename w]
    }
    set gm_redirect_stdout $ofile
    set eof_input 0
    while {!$eof_input} {
	set cmd {}
	while 1 {
	    gets $ifile line
	    append cmd $line\n
	    if {[info complete $cmd] && \
		    [string length [string trim $line]] > 0} {
		break
	    }
	    if {[eof $ifile]} {
		set eof_input 1
		break
	    }
	}
	puts $ofile [clock format [clock seconds]]
	if {[string length [string trim $cmd]] > 0} {
	    puts  $ofile "-----> $cmd"
	    flush $ofile
	    update
	    set errval [catch $cmd msg]
	    puts $ofile $msg
	    if {$errval} {
		set eof_input 1
		puts "script terminated prematurely because of error";
	    }
	}
    }
    close $ifile
    if {$ofilename != ""} {
	close $ofile
    }
}


# ------------------------------------------------------------------
# Copyright (c) 1999 by Cornell University.  All rights reserved
# See the accompanying file 'Copyright' for authorship information,
# the terms of the license governing this software, and disclaimers
# concerning this software.
# ------------------------------------------------------------------
# This file is part of the QMG software.  
# Version 2.0 of QMG, release date September 3, 1999
# ------------------------------------------------------------------