Annotation of capa/capa51/CapaTools/printstudent.1.2.tcl, revision 1.3
1.1 albertel 1: #!/usr/local/bin/tclsh7.6
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.
24:
1.1 albertel 25: # By G. Albertelli II 1998
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.2"
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 adding a class."
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 name 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 path of $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 path 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 seperated list of valid set numbers for $class:"
128: gets file0 aline
129: set sets $aline
130: if { $sets == "quit" } { return quit }
131: puts "You entered $sets, is this list 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 removing a class."
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"
207: puts -nonewline "Enter class name to print:"
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 changing set availability."
230: while { ! $done } {
231: puts "Please enter a space seperated 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 have $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 right now."
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>
![[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