Annotation of capa/capa51/GUITools/webpage.tcl, revision 1.4
1.1 albertel 1: #!/usr/local/bin/tclsh8.0
1.4 ! albertel 2: # generates the webpages to get into a class
! 3: # Copyright (C) 1992-2000 Michigan State University
! 4: #
! 5: # The CAPA system is free software; you can redistribute it and/or
! 6: # modify it under the terms of the GNU Library General Public License as
! 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
! 13: # Library General Public License for more details.
! 14: #
! 15: # You should have received a copy of the GNU Library General Public
! 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:
26: proc outputHeader { } {
27: puts "Content-type: text/html\n\n<HTML><TITLE></TITLE><BODY bgcolor=\"#ffffff\"> "
28: }
29:
30: proc outputFooter {} {
31: puts "</BODY></HTML>"
32: }
33:
34: proc getid.outputButton { capaid argumentsVar } {
35: global machine
36: upvar $argumentsVar arguments
37: puts "<FORM METHOD=\"POST\" ACTION=\"http://$machine/capa-bin/capahtml\">"
38: puts "<input type=\"HIDDEN\" name=\"M\" value=1>"
39: puts "<input type=\"HIDDEN\" name=\"CAPAID\" value=$capaid>"
40: puts "<input type=\"HIDDEN\" name=\"SNUM\" value=$arguments(SNUM)>"
41: puts "<input type=\"HIDDEN\" name=\"CLASS\" value=$arguments(CLASS)>"
42: puts "Click <input type=\"submit\" value=\" here \"> to work on <i>CAPA</i>."
43: puts "</form>"
44: }
45:
46: proc getid.main {argumentsVar} {
47: global config classList
48: upvar $argumentsVar arguments
49: outputHeader
50: if { [array names classList $arguments(CLASS).path] != "" } {
51: set pwd [pwd]
52: catch {cd $classList($arguments(CLASS).path)} error
53: # puts "hey :$error:"
54: catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
55: $arguments(SETID) $arguments(CAPAID) ]} error
56: # puts "hey :$error:"
57: # puts "hey :$error:$result:"
58: switch $result {
59: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
60: InvalidOldCapaID -
61: NotFound { puts "The provided old <i>CAPA</i>ID ($arguments(CAPAID)) is not a valid <i>CAPA</i>ID for any set previous to the requested set $arguments(SETID)." }
62: NotOpen { puts "The set requested, $arguments(SETID), is not open." }
63: default { puts "Your <i>CAPA</i>ID is <font size=+2>$result</font> for Set $arguments(SETID) in class $arguments(CLASS)."; getid.outputButton $result arguments}
64: }
65: cd $pwd
66: } else {
67: puts "Invalid request. Class $arguments(CLASS) not found."
68: }
69: outputFooter
70: }
71:
72: proc capaid.outputButton { capaid argumentsVar } {
73: global machine
74: upvar $argumentsVar arguments
75: puts "<FORM METHOD=\"POST\" ACTION=\"http://$machine/capa-bin/capahtml\">"
76: puts "<input type=\"HIDDEN\" name=\"M\" value=1>"
77: puts "<input type=\"HIDDEN\" name=\"CAPAID\" value=$capaid>"
78: puts "<input type=\"HIDDEN\" name=\"SNUM\" value=$arguments(SNUM)>"
79: puts "<input type=\"HIDDEN\" name=\"CLASS\" value=$arguments(CLASS)>"
80: puts "Click <input type=\"submit\" value=\" here \"> to work on <i>CAPA</i>."
81: puts "</form>"
82: }
83:
84: proc capaid.main {argumentsVar} {
85: global config classList
86: upvar $argumentsVar arguments
87: outputHeader
88: if { [array names classList $arguments(CLASS).path] != "" } {
89: set pwd [pwd]
90: catch {cd $classList($arguments(CLASS).path)} error
91: # puts "hey :$error:"
92: catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
93: $arguments(SETID)]} error
94: # puts "hey :$error:"
95: # puts "hey :$error:$result:"
96: switch $result {
97: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
98: InvalidOldCapaID -
99: NotFound { puts "The provided Student Number $arguments(SNUM) is not a valid for $arguments(CLASS)." }
100: NotOpen { puts "The set requested, $arguments(SETID), is not open." }
101: default { puts "Your <i>CAPA</i>ID is <font size=+2>$result</font> for Set $arguments(SETID) in class $arguments(CLASS)."; capaid.outputButton $result arguments}
102: }
103: cd $pwd
104: } else {
105: puts "Invalid request. Class $arguments(CLASS) not found."
106: }
107: outputFooter
108: }
109:
110: proc emailid.sendmail { what who argumentsVar } {
111: global config
112: upvar $argumentsVar arguments
113: if { $who == "" } {
114: puts "There is no e-mail address available for this student. Please contact you r instructor to obtain your <i>CAPA</i>ID."
115: } else {
116: set mailID [open "|$config(mail) -s \"Requested CAPAID\" $who" w]
117: puts $mailID "The CAPAID you requested for class $arguments(CLASS), set number $arguments(SETID) is $what."
118: close $mailID
119: puts "Your <i>CAPA</i>ID has been mailed to your university e-mail account."
120: }
121: }
122:
123: proc emailid.main {argumentsVar} {
124: global classList config
125: upvar $argumentsVar arguments
126: outputHeader
127: if { [array names classList $arguments(CLASS).path] != "" } {
128: set pwd [pwd]
129: if {[catch {cd $classList($arguments(CLASS).path)} error ]} {
130: puts $error; return
131: }
132: if {[catch {set result [exec $config(webpage) -emailcapaid $arguments(SNUM) \
133: $arguments(SETID) ]} error ]} {
134: puts $error; return
135: }
136: cd $pwd
137: switch $result {
138: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
139: NotOpen { puts "The set requested, $arguments(SETID), is not yet open for access." }
140: NotFound { puts "Unable to find student number $arguments(SNUM) in classlist."}
141: default {
142: if { [catch { eval "emailid.sendmail $result arguments" } error ] } {
143: puts "$error:There is no e-mail address available for this student. Please contact your instructor to obtain your <i>CAPA</i>ID."
144: }
145: }
146: }
147: } else {
148: puts "Invalid request. Class $arguments(CLASS) not found."
149: }
150:
151: outputFooter
152: }
153:
154: proc getSettings { } {
155: global classList
156: set confID [open "class.conf"]
157: set aline [gets $confID]
158: while {![eof $confID]} {
159: set class [lindex $aline 0]
160: set path [lindex $aline 1]
161: set classList($class.path) [file join $path $class]
162: set aline [gets $confID]
163: }
164: }
165:
166: proc ids.main {} {
167: global env
168: getSettings
169: set request [string trim [read file0]]
170: foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
171: catch {set arguments(SETID) [string trimleft $arguments(SETID) 0]}
172: catch {set logFileId [open ids.log "a"]} error
173:
174: set b [split $request "&="]
175: if { [catch {lappend b $env(REMOTE_HOST)}]} {
176: if { [catch {lappend b $env(REMOTE_ADDR)}] } {
177: lappend b UNKNOWN
178: }
179: }
180: puts $logFileId "[clock format [clock seconds]] $b"
181: close $logFileId
182:
183: $arguments(TYPE).main arguments
184: }
185:
186: proc optionlist { match } {
187: global env
188: set request ""
189: catch {puts $env(QUERY_STRING)}
190: catch {set request [string trim $env(QUERY_STRING)]}
191: if { $request == "" } {
192: set arguments(CLASS) ""
193: } else {
194: foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
195: }
196: set confID [open "class.conf"]
197: set aline [gets $confID]
1.2 albertel 198: while {!([eof $confID] && ($aline == ""))} {
1.1 albertel 199: set type [lindex $aline 3]
200: if { [lsearch $type $match] != -1 } {
201: set classname [lindex $aline 0]
202: if { [string toupper $classname] == [string toupper $arguments(CLASS)] } {
203: puts "<option selected> [lindex $aline 0]"
204: } else {
205: puts "<option> [lindex $aline 0]"
206: }
207: }
208: set aline [gets $confID]
209: }
210: }
211:
212: proc main {} {
213: global argv0 machine class.head class.tail emailid.head emailid.tail \
214: getid.head getid.tail capaid.head capaid.tail config
215: eval "global [info globals]"
216: source web.settings
217: switch -glob -- [file tail $argv0] {
218: class.* -
219: index.* {
220: puts "Content-type: text/html\n\n"
1.3 albertel 221: puts "<!-- class.html 5.1 -->"
1.1 albertel 222: puts [subst -nocommands ${class.head}]
223: optionlist class
224: puts [subst -nocommands ${class.tail}]
225: }
226: emailid.* {
227: puts "Content-type: text/html\n\n"
1.3 albertel 228: puts "<!-- emailid.html 5.1 -->"
1.1 albertel 229: puts [subst -nocommands ${emailid.head}]
230: optionlist emailid
231: puts [subst -nocommands ${emailid.tail}]
232: }
233: getid.* {
234: puts "Content-type: text/html\n\n"
1.3 albertel 235: puts "<!-- getid.html 5.1 -->"
1.1 albertel 236: puts [subst -nocommands ${getid.head}]
237: optionlist getid
238: puts [subst -nocommands ${getid.tail}]
239: }
240: capaid.* {
241: puts "Content-type: text/html\n\n"
1.3 albertel 242: puts "<!-- capaid.html 5.1 -->"
1.1 albertel 243: puts [subst -nocommands ${capaid.head}]
244: optionlist capaid
245: puts [subst -nocommands ${capaid.tail}]
246: }
247: default { ids.main }
248: }
249: }
250:
251: main
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to webpage.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools