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>