Annotation of capa/capa51/CapaTools/printstudent.tcl, revision 1.3

1.1       albertel    1: #!/usr/local/bin/tclsh8.0
                      2: # Script to print a single student's assignment
1.2       albertel    3: #  Copyright (C) 1992-2000 Michigan State University
                      4: #
                      5: #  The CAPA system is free software; you can redistribute it and/or
1.3     ! albertel    6: #  modify it under the terms of the GNU General Public License as
1.2       albertel    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
1.3     ! albertel   13: #  General Public License for more details.
1.2       albertel   14: #
1.3     ! albertel   15: #  You should have received a copy of the GNU General Public
1.2       albertel   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.
1.1       albertel   24: # By G. Albertelli II 1998
                     25: # Edited and improved by nedavis
                     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.3"
                     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."
                    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 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 ABSOLUTE path of the 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 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 separated list of valid set numbers for $class:\n EXAMPLE: 1 2 3 \n will make sets 1-3 available."
                    128: 	gets file0 aline
                    129: 	set sets $aline
                    130: 	if { $sets == "quit" } { return quit }
                    131: 	puts "You entered $sets, is this 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."
                    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 \n \n new=add new class \n remove=remove class from available list \n restart=restart from login \n quit=exit from CAPA server \n "
                    207: 	puts -nonewline "For printing, enter classname\n For all else, enter command: "
                    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."
                    230:     while { ! $done } {
                    231: 	puts "Please enter a space separated 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 allow $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. \n Contact the course instructor."
                    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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>