Return to printstudent.1.2.tcl CVS log

Up to [LON-CAPA] / capa / capa51 / CapaTools

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

    1: #!/usr/local/bin/tclsh7.6
    2: # Script to print a single student's assignment
    3: #  Copyright (C) 1992-2000 Michigan State University
    4: #
    5: #  The CAPA system is free software; you can redistribute it and/or
    6: #  modify it under the terms of the GNU General Public License as
    7: #  published by the Free Software Foundation; either version 2 of the
    8: #  License, or (at your option) any later version.
    9: #
   10: #  The CAPA system is distributed in the hope that it will be useful,
   11: #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   12: #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   13: #  General Public License for more details.
   14: #
   15: #  You should have received a copy of the GNU General Public
   16: #  License along with the CAPA system; see the file COPYING.  If not,
   17: #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   18: #  Boston, MA 02111-1307, USA.
   19: #
   20: #  As a special exception, you have permission to link this program
   21: #  with the TtH/TtM library and distribute executables, as long as you
   22: #  follow the requirements of the GNU GPL in regard to all of the
   23: #  software in the executable aside from TtH/TtM.
   24: 
   25: # By G. Albertelli II 1998
   26: 
   27: proc clearScreen {} {
   28:     puts "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
   29: }
   30: clearScreen
   31: puts "CAPA Printing script Ver 1.2"
   32: after 1000
   33: 
   34: proc class { classname path args } {
   35:     global classList
   36:     set classList($classname.path) $path
   37:     set classList($classname.sets) $args
   38: }
   39: 
   40: proc config { var value args } {
   41:     global config
   42:     set config($var) $value
   43: }
   44: 
   45: proc getSettings { classListVar configVar } {
   46:     upvar $classListVar classList
   47:     upvar $configVar config
   48:     source printstudent.settings
   49: }
   50: 
   51: proc saveSettings { } {
   52:     global classList config
   53:     if { [ catch { set fileId [open printstudent.settings "w"] } ] } {
   54: 	puts "Unable to save settings. Please contact CAPA adminstrator."
   55: 	quit "UnableToSaveSettings"
   56:     }
   57:     puts $fileId "# Settings file for printstudent.tcl\n#\n# set up the configuration options\n#\n# the used values are qzparse_command, latex_command, dvips_command, and\n# lpr_command\n\n"
   58:     foreach value [array names config] {
   59: 	puts $fileId "config $value \t\"$config($value)\""
   60:     }
   61: 
   62:     puts $fileId "\n# List of classes, their path, and the sets that can be printed"
   63:     set validClass ""
   64:     foreach name [array names classList] {
   65: 	if { ! [string match *.path $name] } { 
   66: 	    lappend validClass [lindex [split $name .] 0]
   67: 	}
   68:     }
   69:     set validClass [ lsort $validClass]
   70:     foreach class $validClass {
   71: 	puts $fileId "class $class  $classList($class.path) \t$classList($class.sets)"
   72:     }
   73:     close $fileId
   74: }
   75: 
   76: proc getStringFromList { validStrings } {
   77:     gets file0 aline
   78:     set error [catch {set try [lindex $aline 0] } ]
   79:     if { $error } { return "" }
   80:     set found false
   81:     foreach valid $validStrings {
   82: 	set valid [string tolower $valid]
   83: 	set try [ string tolower [ string trim $try ] ]
   84: 	if { $valid == $try } {
   85: 	    set found true
   86: 	    break
   87: 	}
   88:     }
   89:     if { $found } {
   90: 	return $try
   91:     } else {
   92: 	return ""
   93:     }
   94: }
   95: 
   96: proc addClass { classVar } {
   97:     upvar $classVar class
   98:     
   99:     clearScreen
  100:     puts "Enter \"quit\" at any time to stop adding a class."
  101:     set done 0
  102:     while { ! $done } {
  103: 	puts -nonewline "Please enter the name of the class you wish to add:"
  104: 	flush file1
  105: 	gets file0 aline
  106: 	set class [lindex $aline 0]
  107: 	if { $class == "quit" } { return quit }
  108: 	puts "You entered $class, is this name correct? (y or n)"
  109:         set finished [getStringFromList "yes y Y quit"]
  110: 	if { $finished == "quit" } { return quit }
  111: 	if { $finished != "" } { set done 1 }
  112:     }
  113:     set done 0
  114:     while { ! $done } {
  115: 	puts -nonewline "Please enter the path of $class:"
  116: 	flush file1
  117: 	gets file0 aline
  118: 	set path [lindex $aline 0]
  119: 	if { $path == "quit" } { return quit }
  120: 	puts "You entered $path, is this path correct? (y or n)"
  121:         set finished [getStringFromList "yes y Y quit"]
  122: 	if { $finished == "quit" } { return quit }
  123: 	if { $finished != "" } { set done 1 }
  124:     }
  125:     set done 0
  126:     while { ! $done } {
  127: 	puts "Please enter a space seperated list of valid set numbers for $class:"
  128: 	gets file0 aline
  129: 	set sets $aline
  130: 	if { $sets == "quit" } { return quit }
  131: 	puts "You entered $sets, is this list correct? (y or n)"
  132:         set finished [getStringFromList "yes y Y quit"]
  133: 	if { $finished == "quit" } { return quit }
  134: 	if { $finished != "" } { set done 1 }
  135:     }
  136:     global classList
  137:     set classList($class.sets) $sets
  138:     set classList($class.path) $path
  139:     saveSettings
  140:     global machine
  141:     logInformation Added $class $path "$sets" $machine
  142:     set class ""
  143: }
  144: 
  145: proc removeClass { classListVar classVar } {
  146:     upvar $classListVar classList
  147:     upvar $classVar class
  148: 
  149:     clearScreen
  150:     set done 0
  151:     while { ! $done } {
  152: 	set validClass ""
  153: 	foreach name [array names classList] {
  154: 	    if { ! [string match *.path $name] } { 
  155: 		lappend validClass [lindex [split $name .] 0]
  156: 	    }
  157: 	}
  158: 	set validClass [ lsort $validClass]
  159: 	puts "Valid classnames are: $validClass"
  160: 	puts "Enter \"quit\" to stop removing a class."
  161: 	puts -nonewline "Enter class name to remove:"
  162: 	flush file1
  163: 	set class [getStringFromList [concat $validClass quit] ]
  164: 	if { $class == "quit" } { 
  165: 	    set class ""
  166: 	    return
  167: 	}
  168: 	if { $class != "" } { 
  169: 	    puts "You entered $class, are you sure you wish to remove this class? (y or n)"
  170: 	    set finished [getStringFromList "yes y Y quit"]
  171: 	    if { $finished == "quit" } { return quit }
  172: 	    if { $finished != "" } { set done 1 }
  173: 	} else { 
  174: 	    puts "Invalid classname"
  175: 	}
  176:     }
  177:     if { $done } {
  178: 	global classList 
  179: 	global machine
  180: 	logInformation Removed $class $classList($class.path) "$classList($class.sets)" $machine
  181: 	catch { unset classList($class.path) }
  182: 	catch { unset classList($class.sets) }
  183: 	saveSettings
  184:     }
  185:     set class ""
  186: }
  187: 
  188: proc getClass { classListVar classVar } {
  189:     upvar $classListVar classList
  190:     upvar $classVar class
  191: 
  192:     clearScreen
  193:     set done 0
  194:     while { ! $done } {
  195: 	set validClass ""
  196: 	foreach name [array names classList] {
  197: 	    if { ! [string match *.path $name] } { 
  198: 		lappend validClass [lindex [split $name .] 0]
  199: 	    }
  200: 	}
  201: 	set validClass [ lsort $validClass]
  202: 	puts "Valid classnames are: [lindex $validClass 0]"
  203: 	foreach otherClass [lrange $validClass 1 end] {
  204: 	    puts "                      $otherClass"
  205: 	}
  206: 	puts "Other commands available: new remove restart quit"
  207: 	puts -nonewline "Enter class name to print:"
  208: 	flush file1
  209: 	set class [getStringFromList \
  210: 		[concat $validClass new remove quit restart] ]
  211: 	if       { $class == "new"     } { addClass class 
  212: 	                                   clearScreen
  213: 	} elseif { $class == "remove"  } { removeClass classList class 
  214:                                            clearScreen
  215: 	} elseif { $class == "quit"    } { quit "ClassEarlyOut" 
  216: 	} elseif { $class == "restart" } { return restart 
  217: 	} elseif { $class != ""        } { set done 1
  218: 	} else   {                         puts "Invalid classname"
  219: 	}
  220:     }
  221: }
  222: 
  223: proc addSet { class setVar } {
  224:     upvar $setVar setWanted
  225:     global classList 
  226: 
  227:     clearScreen
  228:     set done 0
  229:     puts "Enter \"quit\" at any time to stop changing set availability."
  230:     while { ! $done } {
  231: 	puts "Please enter a space seperated list of valid set numbers for $class:"
  232: 	gets file0 aline
  233: 	set sets $aline
  234: 	if { $sets == "quit" } { return quit }
  235: 	puts -nonewline "You entered $sets, which would have $class have set(s) $sets available, rather than set(s) $classList($class.sets).\n Is this correct? (y or n)"
  236: 	flush file1
  237:         set finished [getStringFromList "yes y Y quit"]
  238: 	if { $finished == "quit" } { return quit }
  239: 	if { $finished != "" } { set done 1 }
  240:     }
  241:     global classList
  242:     global machine
  243:     logInformation ChangedSets $class $classList($class.path) "\"$classList($class.sets)\" to \"$sets\"" $machine
  244:     set classList($class.sets) $sets
  245:     saveSettings
  246:     return ""
  247: }
  248:     
  249: proc getSet { classListVar class setVar } {
  250:     upvar $classListVar classList
  251:     upvar $setVar setWanted
  252: 
  253:     clearScreen
  254:     set done 0
  255:     while { ! $done } {
  256: 	puts "Valid set numbers for $class are: $classList($class.sets) "
  257: 	puts "Other commands available: new restart quit"
  258: 	puts -nonewline "Enter set number to print:"
  259: 	flush file1
  260: 	set setWanted [getStringFromList \
  261: 		[concat $classList($class.sets) new quit restart] ]
  262: 	if       { $setWanted == "new"     } { addSet $class setWanted 
  263:                                                clearScreen
  264:         } elseif { $setWanted == "quit"    } { quit "SetEarlyOut" 
  265: 	} elseif { $setWanted == "restart" } { return restart 
  266:         } elseif { $setWanted != ""        } { set done 1
  267: 	} else   {                             puts "Invalid setnumber."
  268: 	}
  269:     }
  270: }
  271: 
  272: proc getStudentInfo { studentNumberVar } {
  273:     upvar $studentNumberVar studentNumber
  274:     global class set
  275: 
  276:     puts "Other commands available: restart quit"
  277:     puts -nonewline "For class: $class, set $set, enter student number:"
  278:     flush file1
  279:     gets file0 aline
  280:     catch { set studentNumber [lindex $aline 0]}
  281:     if { $studentNumber == "quit" } { quit "StudentInfoEarlyOut" }
  282:     if { $studentNumber == "restart" } { return restart }
  283: }
  284: 
  285: proc verifyStudent { class set studentNumber } {
  286:     if { [ catch { set fileId [open $class/classl "r" ] } ] } {
  287: 	puts "Unable to find a classl file. This class may not be ready for printing right now."
  288: 	quit "UnableToAccesClassl"
  289:     }
  290:     set result 0
  291:     while { 1 } {
  292: 	gets $fileId aline
  293: 	if { [eof $fileId] } { break }
  294: 	if { [string tolower $studentNumber] == [string tolower [ string range $aline 14 22] ] } {
  295: 	    set result 1
  296: 	    break
  297: 	}
  298:     }
  299:     close $fileId
  300:     return $result
  301: }
  302: 
  303: proc printSet { class set studentnumber configVar } {
  304:     upvar $configVar config
  305:     
  306:     puts "Parsing Set"
  307:     if { [catch { eval "exec $config(qzparse_command) -c $class -Set $set -Stu $studentnumber -o [pwd]/printstudent.[pid].tex " } errorMsg ] } {
  308: 	puts "Unable to prepare tex file: $errorMsg"
  309: 	return failed
  310:     } 
  311:     puts "Creating Set description"
  312:     if { [catch { eval "exec $config(latex_command) ./printstudent.[pid].tex < /dev/null " } errorMsg ] } {
  313: 	puts "Unable to prepare dvi file: $errorMsg"
  314: 	return failed
  315:     }
  316:     puts "Creating postscript file"
  317:     if { [ catch { eval "exec $config(dvips_command) -o ./printstudent.[pid].ps ./printstudent.[pid].dvi < /dev/null >& /dev/null " } errorMsg ] } {
  318: 	puts "Unable to prepare ps file: $errorMsg"
  319: 	return failed
  320:     }
  321:     puts "Sending file to printer"
  322:     if { [ catch { eval "exec $config(lpr_command) ./printstudent.[pid].ps < /dev/null " } errorMsg ] } {
  323: 	puts "Unable to print ps file: $errorMsg"
  324: 	return failed
  325:     }
  326:     return success
  327: }
  328: 
  329: proc logInformation { result class set student args } {
  330:     set fileId [open "printstudent.log" "a"]
  331:     puts $fileId "$result $class $set $student $args [clock format [clock seconds] -format %m/%d/%Y-%H:%M:%S ]"
  332:     close $fileId
  333: }
  334: 
  335: proc cleanup {} {
  336:     exec rm -f ./printstudent.[pid].ps ./printstudent.[pid].dvi ./printstudent.[pid].tex ./printstudent.[pid].aux ./printstudent.[pid].log
  337: }
  338: 
  339: proc goAgain {} {
  340:     puts "Would you like to print another assignment (y or n) ?"
  341:     set setWanted [getStringFromList "yes y Y quit"]
  342:     if { $setWanted != "" } { 	return 1
  343:     } else { 	return 0
  344:     }
  345: }
  346: 
  347: proc quit { args } {
  348:     global class set studentnumber machine
  349:     logInformation $args $class $set $studentnumber $machine
  350:     exit
  351: }
  352: 
  353: set another 1
  354: set class "unknown"
  355: set set "unknown"
  356: set studentnumber "unknown"
  357: if { [ catch { set machine [lindex [exec /usr/bin/who -mM ] end ] } ] } {
  358:     set machine "UnableToRunWho"
  359: }
  360: 
  361: while { $another } {
  362:     getSettings classList config
  363:     if { "restart" == [getClass classList class] } { continue }
  364:     if { "restart" == [getSet classList $class set] } { continue }
  365:     clearScreen
  366:     set done 0
  367:     while { ! $done } {
  368: 	if { "restart" == [getStudentInfo studentnumber] } { 
  369: 	    set studentnumber restart
  370: 	    break
  371: 	}
  372: 	if { ! [set done [verifyStudent $classList($class.path) \
  373: 		$set $studentnumber] ] } {
  374: 	    puts "Student number: $studentnumber, does not appear to belong in the class- $class."
  375: 	    logInformation "NotFound" $class $set $studentnumber $machine
  376: 	}
  377:     }
  378:     if { $studentnumber == "restart" } { continue }
  379:     logInformation [printSet $classList($class.path) $set \
  380: 	    $studentnumber config] $class $set $studentnumber $machine
  381:     cleanup
  382:     set another [goAgain]
  383: }
  384: 
  385: 
  386: 
  387: 
  388: 
  389: