Annotation of capa/capa51/GUITools/webpage.tcl, revision 1.1
1.1 ! albertel 1: #!/usr/local/bin/tclsh8.0
! 2:
! 3: proc outputHeader { } {
! 4: puts "Content-type: text/html\n\n<HTML><TITLE></TITLE><BODY bgcolor=\"#ffffff\"> "
! 5: }
! 6:
! 7: proc outputFooter {} {
! 8: puts "</BODY></HTML>"
! 9: }
! 10:
! 11: proc getid.outputButton { capaid argumentsVar } {
! 12: global machine
! 13: upvar $argumentsVar arguments
! 14: puts "<FORM METHOD=\"POST\" ACTION=\"http://$machine/capa-bin/capahtml\">"
! 15: puts "<input type=\"HIDDEN\" name=\"M\" value=1>"
! 16: puts "<input type=\"HIDDEN\" name=\"CAPAID\" value=$capaid>"
! 17: puts "<input type=\"HIDDEN\" name=\"SNUM\" value=$arguments(SNUM)>"
! 18: puts "<input type=\"HIDDEN\" name=\"CLASS\" value=$arguments(CLASS)>"
! 19: puts "Click <input type=\"submit\" value=\" here \"> to work on <i>CAPA</i>."
! 20: puts "</form>"
! 21: }
! 22:
! 23: proc getid.main {argumentsVar} {
! 24: global config classList
! 25: upvar $argumentsVar arguments
! 26: outputHeader
! 27: if { [array names classList $arguments(CLASS).path] != "" } {
! 28: set pwd [pwd]
! 29: catch {cd $classList($arguments(CLASS).path)} error
! 30: # puts "hey :$error:"
! 31: catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
! 32: $arguments(SETID) $arguments(CAPAID) ]} error
! 33: # puts "hey :$error:"
! 34: # puts "hey :$error:$result:"
! 35: switch $result {
! 36: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
! 37: InvalidOldCapaID -
! 38: 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)." }
! 39: NotOpen { puts "The set requested, $arguments(SETID), is not open." }
! 40: 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}
! 41: }
! 42: cd $pwd
! 43: } else {
! 44: puts "Invalid request. Class $arguments(CLASS) not found."
! 45: }
! 46: outputFooter
! 47: }
! 48:
! 49: proc capaid.outputButton { capaid argumentsVar } {
! 50: global machine
! 51: upvar $argumentsVar arguments
! 52: puts "<FORM METHOD=\"POST\" ACTION=\"http://$machine/capa-bin/capahtml\">"
! 53: puts "<input type=\"HIDDEN\" name=\"M\" value=1>"
! 54: puts "<input type=\"HIDDEN\" name=\"CAPAID\" value=$capaid>"
! 55: puts "<input type=\"HIDDEN\" name=\"SNUM\" value=$arguments(SNUM)>"
! 56: puts "<input type=\"HIDDEN\" name=\"CLASS\" value=$arguments(CLASS)>"
! 57: puts "Click <input type=\"submit\" value=\" here \"> to work on <i>CAPA</i>."
! 58: puts "</form>"
! 59: }
! 60:
! 61: proc capaid.main {argumentsVar} {
! 62: global config classList
! 63: upvar $argumentsVar arguments
! 64: outputHeader
! 65: if { [array names classList $arguments(CLASS).path] != "" } {
! 66: set pwd [pwd]
! 67: catch {cd $classList($arguments(CLASS).path)} error
! 68: # puts "hey :$error:"
! 69: catch {set result [exec $config(webpage) -getid $arguments(SNUM) \
! 70: $arguments(SETID)]} error
! 71: # puts "hey :$error:"
! 72: # puts "hey :$error:$result:"
! 73: switch $result {
! 74: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
! 75: InvalidOldCapaID -
! 76: NotFound { puts "The provided Student Number $arguments(SNUM) is not a valid for $arguments(CLASS)." }
! 77: NotOpen { puts "The set requested, $arguments(SETID), is not open." }
! 78: 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}
! 79: }
! 80: cd $pwd
! 81: } else {
! 82: puts "Invalid request. Class $arguments(CLASS) not found."
! 83: }
! 84: outputFooter
! 85: }
! 86:
! 87: proc emailid.sendmail { what who argumentsVar } {
! 88: global config
! 89: upvar $argumentsVar arguments
! 90: if { $who == "" } {
! 91: puts "There is no e-mail address available for this student. Please contact you r instructor to obtain your <i>CAPA</i>ID."
! 92: } else {
! 93: set mailID [open "|$config(mail) -s \"Requested CAPAID\" $who" w]
! 94: puts $mailID "The CAPAID you requested for class $arguments(CLASS), set number $arguments(SETID) is $what."
! 95: close $mailID
! 96: puts "Your <i>CAPA</i>ID has been mailed to your university e-mail account."
! 97: }
! 98: }
! 99:
! 100: proc emailid.main {argumentsVar} {
! 101: global classList config
! 102: upvar $argumentsVar arguments
! 103: outputHeader
! 104: if { [array names classList $arguments(CLASS).path] != "" } {
! 105: set pwd [pwd]
! 106: if {[catch {cd $classList($arguments(CLASS).path)} error ]} {
! 107: puts $error; return
! 108: }
! 109: if {[catch {set result [exec $config(webpage) -emailcapaid $arguments(SNUM) \
! 110: $arguments(SETID) ]} error ]} {
! 111: puts $error; return
! 112: }
! 113: cd $pwd
! 114: switch $result {
! 115: InvalidSetId { puts "The set requested, $arguments(SETID), is not a valid set number." }
! 116: NotOpen { puts "The set requested, $arguments(SETID), is not yet open for access." }
! 117: NotFound { puts "Unable to find student number $arguments(SNUM) in classlist."}
! 118: default {
! 119: if { [catch { eval "emailid.sendmail $result arguments" } error ] } {
! 120: puts "$error:There is no e-mail address available for this student. Please contact your instructor to obtain your <i>CAPA</i>ID."
! 121: }
! 122: }
! 123: }
! 124: } else {
! 125: puts "Invalid request. Class $arguments(CLASS) not found."
! 126: }
! 127:
! 128: outputFooter
! 129: }
! 130:
! 131: proc getSettings { } {
! 132: global classList
! 133: set confID [open "class.conf"]
! 134: set aline [gets $confID]
! 135: while {![eof $confID]} {
! 136: set class [lindex $aline 0]
! 137: set path [lindex $aline 1]
! 138: set classList($class.path) [file join $path $class]
! 139: set aline [gets $confID]
! 140: }
! 141: }
! 142:
! 143: proc ids.main {} {
! 144: global env
! 145: getSettings
! 146: set request [string trim [read file0]]
! 147: foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
! 148: catch {set arguments(SETID) [string trimleft $arguments(SETID) 0]}
! 149: catch {set logFileId [open ids.log "a"]} error
! 150:
! 151: set b [split $request "&="]
! 152: if { [catch {lappend b $env(REMOTE_HOST)}]} {
! 153: if { [catch {lappend b $env(REMOTE_ADDR)}] } {
! 154: lappend b UNKNOWN
! 155: }
! 156: }
! 157: puts $logFileId "[clock format [clock seconds]] $b"
! 158: close $logFileId
! 159:
! 160: $arguments(TYPE).main arguments
! 161: }
! 162:
! 163: proc optionlist { match } {
! 164: global env
! 165: set request ""
! 166: catch {puts $env(QUERY_STRING)}
! 167: catch {set request [string trim $env(QUERY_STRING)]}
! 168: if { $request == "" } {
! 169: set arguments(CLASS) ""
! 170: } else {
! 171: foreach {var value} [split $request "&="] {set arguments($var) [string trim $value]}
! 172: }
! 173: set confID [open "class.conf"]
! 174: set aline [gets $confID]
! 175: while {![eof $confID]} {
! 176: set type [lindex $aline 3]
! 177: if { [lsearch $type $match] != -1 } {
! 178: set classname [lindex $aline 0]
! 179: if { [string toupper $classname] == [string toupper $arguments(CLASS)] } {
! 180: puts "<option selected> [lindex $aline 0]"
! 181: } else {
! 182: puts "<option> [lindex $aline 0]"
! 183: }
! 184: }
! 185: set aline [gets $confID]
! 186: }
! 187: }
! 188:
! 189: proc main {} {
! 190: global argv0 machine class.head class.tail emailid.head emailid.tail \
! 191: getid.head getid.tail capaid.head capaid.tail config
! 192: eval "global [info globals]"
! 193: source web.settings
! 194: switch -glob -- [file tail $argv0] {
! 195: class.* -
! 196: index.* {
! 197: puts "Content-type: text/html\n\n"
! 198: puts [subst -nocommands ${class.head}]
! 199: optionlist class
! 200: puts [subst -nocommands ${class.tail}]
! 201: }
! 202: emailid.* {
! 203: puts "Content-type: text/html\n\n"
! 204: puts [subst -nocommands ${emailid.head}]
! 205: optionlist emailid
! 206: puts [subst -nocommands ${emailid.tail}]
! 207: }
! 208: getid.* {
! 209: puts "Content-type: text/html\n\n"
! 210: puts [subst -nocommands ${getid.head}]
! 211: optionlist getid
! 212: puts [subst -nocommands ${getid.tail}]
! 213: }
! 214: capaid.* {
! 215: puts "Content-type: text/html\n\n"
! 216: puts [subst -nocommands ${capaid.head}]
! 217: optionlist capaid
! 218: puts [subst -nocommands ${capaid.tail}]
! 219: }
! 220: default { ids.main }
! 221: }
! 222: }
! 223:
! 224: 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