Annotation of capa/capa51/CapaTools/printstudent.1.2.tcl, revision 1.1.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