Annotation of capa/capa51/CapaTools/printstudent.tcl, revision 1.1
1.1 ! albertel 1: #!/usr/local/bin/tclsh8.0
! 2: # Script to print a single student's assignment
! 3: # By G. Albertelli II 1998
! 4: # Edited and improved by nedavis
! 5:
! 6: proc clearScreen {} {
! 7: 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"
! 8: }
! 9: clearScreen
! 10: puts "CAPA Printing script Ver 1.3"
! 11: after 1000
! 12:
! 13: proc class { classname path args } {
! 14: global classList
! 15: set classList($classname.path) $path
! 16: set classList($classname.sets) $args
! 17: }
! 18:
! 19: proc config { var value args } {
! 20: global config
! 21: set config($var) $value
! 22: }
! 23:
! 24: proc getSettings { classListVar configVar } {
! 25: upvar $classListVar classList
! 26: upvar $configVar config
! 27: source printstudent.settings
! 28: }
! 29:
! 30: proc saveSettings { } {
! 31: global classList config
! 32: if { [ catch { set fileId [open printstudent.settings "w"] } ] } {
! 33: puts "Unable to save settings. Please contact CAPA adminstrator."
! 34: quit "UnableToSaveSettings"
! 35: }
! 36: 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"
! 37: foreach value [array names config] {
! 38: puts $fileId "config $value \t\"$config($value)\""
! 39: }
! 40:
! 41: puts $fileId "\n# List of classes, their path, and the sets that can be printed"
! 42: set validClass ""
! 43: foreach name [array names classList] {
! 44: if { ! [string match *.path $name] } {
! 45: lappend validClass [lindex [split $name .] 0]
! 46: }
! 47: }
! 48: set validClass [ lsort $validClass]
! 49: foreach class $validClass {
! 50: puts $fileId "class $class $classList($class.path) \t$classList($class.sets)"
! 51: }
! 52: close $fileId
! 53: }
! 54:
! 55: proc getStringFromList { validStrings } {
! 56: gets file0 aline
! 57: set error [catch {set try [lindex $aline 0] } ]
! 58: if { $error } { return "" }
! 59: set found false
! 60: foreach valid $validStrings {
! 61: set valid [string tolower $valid]
! 62: set try [ string tolower [ string trim $try ] ]
! 63: if { $valid == $try } {
! 64: set found true
! 65: break
! 66: }
! 67: }
! 68: if { $found } {
! 69: return $try
! 70: } else {
! 71: return ""
! 72: }
! 73: }
! 74:
! 75: proc addClass { classVar } {
! 76: upvar $classVar class
! 77:
! 78: clearScreen
! 79: puts "Enter \"quit\" at any time to stop."
! 80: set done 0
! 81: while { ! $done } {
! 82: puts -nonewline "Please enter the name of the class you wish to add:"
! 83: flush file1
! 84: gets file0 aline
! 85: set class [lindex $aline 0]
! 86: if { $class == "quit" } { return quit }
! 87: puts "You entered $class, is this correct? (y or n)"
! 88: set finished [getStringFromList "yes y Y quit"]
! 89: if { $finished == "quit" } { return quit }
! 90: if { $finished != "" } { set done 1 }
! 91: }
! 92: set done 0
! 93: while { ! $done } {
! 94: puts -nonewline "Please enter the ABSOLUTE path of the class."
! 95: flush file1
! 96: gets file0 aline
! 97: set path [lindex $aline 0]
! 98: if { $path == "quit" } { return quit }
! 99: puts "You entered $path, is this correct? (y or n)"
! 100: set finished [getStringFromList "yes y Y quit"]
! 101: if { $finished == "quit" } { return quit }
! 102: if { $finished != "" } { set done 1 }
! 103: }
! 104: set done 0
! 105: while { ! $done } {
! 106: 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."
! 107: gets file0 aline
! 108: set sets $aline
! 109: if { $sets == "quit" } { return quit }
! 110: puts "You entered $sets, is this correct? (y or n)"
! 111: set finished [getStringFromList "yes y Y quit"]
! 112: if { $finished == "quit" } { return quit }
! 113: if { $finished != "" } { set done 1 }
! 114: }
! 115: global classList
! 116: set classList($class.sets) $sets
! 117: set classList($class.path) $path
! 118: saveSettings
! 119: global machine
! 120: logInformation Added $class $path "$sets" $machine
! 121: set class ""
! 122: }
! 123:
! 124: proc removeClass { classListVar classVar } {
! 125: upvar $classListVar classList
! 126: upvar $classVar class
! 127:
! 128: clearScreen
! 129: set done 0
! 130: while { ! $done } {
! 131: set validClass ""
! 132: foreach name [array names classList] {
! 133: if { ! [string match *.path $name] } {
! 134: lappend validClass [lindex [split $name .] 0]
! 135: }
! 136: }
! 137: set validClass [ lsort $validClass]
! 138: puts "Valid classnames are: $validClass"
! 139: puts "Enter \"quit\" to stop."
! 140: puts -nonewline "Enter class name to remove:"
! 141: flush file1
! 142: set class [getStringFromList [concat $validClass quit] ]
! 143: if { $class == "quit" } {
! 144: set class ""
! 145: return
! 146: }
! 147: if { $class != "" } {
! 148: puts "You entered $class, are you sure you wish to remove this class? (y or n)"
! 149: set finished [getStringFromList "yes y Y quit"]
! 150: if { $finished == "quit" } { return quit }
! 151: if { $finished != "" } { set done 1 }
! 152: } else {
! 153: puts "Invalid classname"
! 154: }
! 155: }
! 156: if { $done } {
! 157: global classList
! 158: global machine
! 159: logInformation Removed $class $classList($class.path) "$classList($class.sets)" $machine
! 160: catch { unset classList($class.path) }
! 161: catch { unset classList($class.sets) }
! 162: saveSettings
! 163: }
! 164: set class ""
! 165: }
! 166:
! 167: proc getClass { classListVar classVar } {
! 168: upvar $classListVar classList
! 169: upvar $classVar class
! 170:
! 171: clearScreen
! 172: set done 0
! 173: while { ! $done } {
! 174: set validClass ""
! 175: foreach name [array names classList] {
! 176: if { ! [string match *.path $name] } {
! 177: lappend validClass [lindex [split $name .] 0]
! 178: }
! 179: }
! 180: set validClass [ lsort $validClass]
! 181: puts "Valid classnames are: [lindex $validClass 0]"
! 182: foreach otherClass [lrange $validClass 1 end] {
! 183: puts " $otherClass"
! 184: }
! 185: 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 "
! 186: puts -nonewline "For printing, enter classname\n For all else, enter command: "
! 187: flush file1
! 188: set class [getStringFromList \
! 189: [concat $validClass new remove quit restart] ]
! 190: if { $class == "new" } { addClass class
! 191: clearScreen
! 192: } elseif { $class == "remove" } { removeClass classList class
! 193: clearScreen
! 194: } elseif { $class == "quit" } { quit "ClassEarlyOut"
! 195: } elseif { $class == "restart" } { return restart
! 196: } elseif { $class != "" } { set done 1
! 197: } else { puts "Invalid classname"
! 198: }
! 199: }
! 200: }
! 201:
! 202: proc addSet { class setVar } {
! 203: upvar $setVar setWanted
! 204: global classList
! 205:
! 206: clearScreen
! 207: set done 0
! 208: puts "Enter \"quit\" at any time to stop."
! 209: while { ! $done } {
! 210: puts "Please enter a space separated list of valid set numbers for $class:"
! 211: gets file0 aline
! 212: set sets $aline
! 213: if { $sets == "quit" } { return quit }
! 214: 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)"
! 215: flush file1
! 216: set finished [getStringFromList "yes y Y quit"]
! 217: if { $finished == "quit" } { return quit }
! 218: if { $finished != "" } { set done 1 }
! 219: }
! 220: global classList
! 221: global machine
! 222: logInformation ChangedSets $class $classList($class.path) "\"$classList($class.sets)\" to \"$sets\"" $machine
! 223: set classList($class.sets) $sets
! 224: saveSettings
! 225: return ""
! 226: }
! 227:
! 228: proc getSet { classListVar class setVar } {
! 229: upvar $classListVar classList
! 230: upvar $setVar setWanted
! 231:
! 232: clearScreen
! 233: set done 0
! 234: while { ! $done } {
! 235: puts "Valid set numbers for $class are: $classList($class.sets) "
! 236: puts "Other commands available: new restart quit"
! 237: puts -nonewline "Enter set number to print:"
! 238: flush file1
! 239: set setWanted [getStringFromList \
! 240: [concat $classList($class.sets) new quit restart] ]
! 241: if { $setWanted == "new" } { addSet $class setWanted
! 242: clearScreen
! 243: } elseif { $setWanted == "quit" } { quit "SetEarlyOut"
! 244: } elseif { $setWanted == "restart" } { return restart
! 245: } elseif { $setWanted != "" } { set done 1
! 246: } else { puts "Invalid setnumber."
! 247: }
! 248: }
! 249: }
! 250:
! 251: proc getStudentInfo { studentNumberVar } {
! 252: upvar $studentNumberVar studentNumber
! 253: global class set
! 254:
! 255: puts "Other commands available: restart quit"
! 256: puts -nonewline "For class: $class, set $set, enter student number:"
! 257: flush file1
! 258: gets file0 aline
! 259: catch { set studentNumber [lindex $aline 0]}
! 260: if { $studentNumber == "quit" } { quit "StudentInfoEarlyOut" }
! 261: if { $studentNumber == "restart" } { return restart }
! 262: }
! 263:
! 264: proc verifyStudent { class set studentNumber } {
! 265: if { [ catch { set fileId [open $class/classl "r" ] } ] } {
! 266: puts "Unable to find a classl file. This class may not be ready for printing. \n Contact the course instructor."
! 267: quit "UnableToAccesClassl"
! 268: }
! 269: set result 0
! 270: while { 1 } {
! 271: gets $fileId aline
! 272: if { [eof $fileId] } { break }
! 273: if { [string tolower $studentNumber] == [string tolower [ string range $aline 14 22] ] } {
! 274: set result 1
! 275: break
! 276: }
! 277: }
! 278: close $fileId
! 279: return $result
! 280: }
! 281:
! 282: proc printSet { class set studentnumber configVar } {
! 283: upvar $configVar config
! 284:
! 285: puts "Parsing Set"
! 286: if { [catch { eval "exec $config(qzparse_command) -c $class -Set $set -Stu $studentnumber -o [pwd]/printstudent.[pid].tex " } errorMsg ] } {
! 287: puts "Unable to prepare tex file: $errorMsg"
! 288: return failed
! 289: }
! 290: puts "Creating Set description"
! 291: if { [catch { eval "exec $config(latex_command) ./printstudent.[pid].tex < /dev/null " } errorMsg ] } {
! 292: puts "Unable to prepare dvi file: $errorMsg"
! 293: return failed
! 294: }
! 295: puts "Creating postscript file"
! 296: if { [ catch { eval "exec $config(dvips_command) -o ./printstudent.[pid].ps ./printstudent.[pid].dvi < /dev/null >& /dev/null " } errorMsg ] } {
! 297: puts "Unable to prepare ps file: $errorMsg"
! 298: return failed
! 299: }
! 300: puts "Sending file to printer"
! 301: if { [ catch { eval "exec $config(lpr_command) ./printstudent.[pid].ps < /dev/null " } errorMsg ] } {
! 302: puts "Unable to print ps file: $errorMsg"
! 303: return failed
! 304: }
! 305: return success
! 306: }
! 307:
! 308: proc logInformation { result class set student args } {
! 309: set fileId [open "printstudent.log" "a"]
! 310: puts $fileId "$result $class $set $student $args [clock format [clock seconds] -format %m/%d/%Y-%H:%M:%S ]"
! 311: close $fileId
! 312: }
! 313:
! 314: proc cleanup {} {
! 315: exec rm -f ./printstudent.[pid].ps ./printstudent.[pid].dvi ./printstudent.[pid].tex ./printstudent.[pid].aux ./printstudent.[pid].log
! 316: }
! 317:
! 318: proc goAgain {} {
! 319: puts "Would you like to print another assignment (y or n) ?"
! 320: set setWanted [getStringFromList "yes y Y quit"]
! 321: if { $setWanted != "" } { return 1
! 322: } else { return 0
! 323: }
! 324: }
! 325:
! 326: proc quit { args } {
! 327: global class set studentnumber machine
! 328: logInformation $args $class $set $studentnumber $machine
! 329: exit
! 330: }
! 331:
! 332: set another 1
! 333: set class "unknown"
! 334: set set "unknown"
! 335: set studentnumber "unknown"
! 336: if { [ catch { set machine [lindex [exec /usr/bin/who -mM ] end ] } ] } {
! 337: set machine "UnableToRunWho"
! 338: }
! 339:
! 340: while { $another } {
! 341: getSettings classList config
! 342: if { "restart" == [getClass classList class] } { continue }
! 343: if { "restart" == [getSet classList $class set] } { continue }
! 344: clearScreen
! 345: set done 0
! 346: while { ! $done } {
! 347: if { "restart" == [getStudentInfo studentnumber] } {
! 348: set studentnumber restart
! 349: break
! 350: }
! 351: if { ! [set done [verifyStudent $classList($class.path) \
! 352: $set $studentnumber] ] } {
! 353: puts "Student number: $studentnumber, does not appear to belong in the class- $class."
! 354: logInformation "NotFound" $class $set $studentnumber $machine
! 355: }
! 356: }
! 357: if { $studentnumber == "restart" } { continue }
! 358: logInformation [printSet $classList($class.path) $set \
! 359: $studentnumber config] $class $set $studentnumber $machine
! 360: cleanup
! 361: set another [goAgain]
! 362: }
! 363:
! 364:
! 365:
! 366:
! 367:
! 368:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to printstudent.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / CapaTools