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