capa/capa51/GUITools/webpage.tcl - view

File: [LON-CAPA] / capa / capa51 / GUITools / webpage.tcl
Revision 1.5: download - view: text, annotated - select for diffs
Mon Aug 7 20:47:29 2000 UTC (23 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_2_0, version_2_1_X, version_2_1_99_3, version_2_1_99_2, version_2_1_99_1, version_2_1_99_0, version_2_1_3, version_2_1_2, version_2_1_1, version_2_1_0, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, version_2_0_X, version_2_0_99_1, version_2_0_2, version_2_0_1, version_2_0_0, version_1_99_3, version_1_99_2, version_1_99_1_tmcc, version_1_99_1, version_1_99_0_tmcc, version_1_99_0, version_1_3_X, version_1_3_3, version_1_3_2, version_1_3_1, version_1_3_0, version_1_2_X, version_1_2_99_1, version_1_2_99_0, version_1_2_1, version_1_2_0, version_1_1_X, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, version_1_1_3, version_1_1_2, version_1_1_1, version_1_1_0, version_1_0_99_3, version_1_0_99_2, version_1_0_99_1, version_1_0_99, version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, version_0_99_3, version_0_99_2, version_0_99_1, version_0_99_0, version_0_6_2, version_0_6, version_0_5_1, version_0_5, version_0_4, stable_2002_spring, stable_2002_july, stable_2002_april, stable_2001_fall, release_5-1-3, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, conference_2003, bz6209-base, bz6209, STABLE, HEAD, GCI_3, GCI_2, GCI_1, CAPA_5-1-6, CAPA_5-1-5, CAPA_5-1-4_RC1, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

1: #!/usr/local/bin/tclsh8.0 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 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: # General Public License for more details. 14: # 15: # You should have received a copy of the GNU 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: 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] 198: while {!([eof $confID] && ($aline == ""))} { 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" 221: puts "" 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" 228: puts "" 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" 235: puts "" 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" 242: puts "" 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