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