summaryrefslogtreecommitdiff
path: root/GradeBook_lib.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'GradeBook_lib.tcl')
-rwxr-xr-xGradeBook_lib.tcl809
1 files changed, 809 insertions, 0 deletions
diff --git a/GradeBook_lib.tcl b/GradeBook_lib.tcl
new file mode 100755
index 0000000..4987b7d
--- /dev/null
+++ b/GradeBook_lib.tcl
@@ -0,0 +1,809 @@
+#!/bin/sh
+# (C) 2010 by Eugeniy Mikhailov, <evgmik@gmail.com>
+# vim:set ft=tcl: \
+exec tclsh "$0" "$@"
+
+# internal version of this code
+set VERSION 1.0
+
+# ########################## procs begin #################################
+proc dbg {msg {level 1}} {
+ if { $level <=2 } {
+ set fid [open log a+]
+ puts $fid $msg
+ close $fid
+ }
+}
+
+proc ColName2SqlSafeForm {colname} {
+ set bad_symbols [list {\}} {\{} {\\} {\'} {\"} {\]} {\[} ]
+ foreach bs $bad_symbols {
+ regsub -all $bs $colname "" colname
+ }
+ return $colname
+}
+
+proc AddUserNonWeb { first_name last_name user_name password_hash {group_name {guest}} {id_number {}} {section_num {} } } {
+ set eval_str [concat INSERT INTO GradesTable (FirstName, LastName, UserName, PasswordHash, GroupName, IdNum, SectionNum) VALUES('$first_name', '$last_name', '$user_name', '$password_hash', '$group_name', '$id_number', '$section_num')]
+ set err [catch {db eval $eval_str } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+}
+
+proc CreateGradesTable {db} {
+ set err [catch {db eval {CREATE TABLE GradesTable(FirstName text, LastName text, UserName text, PasswordHash text, GroupName text, UserHiddenColums text, UserHiddenGroups text, IdNum text, SectionNum text)} } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 1
+ }
+
+ # add special users aka special info rows
+ AddUserNonWeb {} {} _Col_Category_ {} inforow
+ AddUserNonWeb {} {} _Max_Points_ {} inforow
+
+ # reasonable defaults for hidden columns
+ #set instructor_hidden_columns [list UserHiddenColums PasswordHash UserHiddenGroups IdNum]
+ #UpdateColValue4GroupNameNonWeb UserHiddenColums instructor $instructor_hidden_columns
+}
+
+proc AddAccessRightNonWeb { action instructor_right ta_right student_right guest_right } {
+ set eval_str [concat INSERT INTO AccessRightsTable (actionname, instructor, ta, student, guest) VALUES('$action', '$instructor_right', '$ta_right', '$student_right', '$guest_right')]
+ set err [catch {db eval $eval_str } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+}
+
+proc CreateAccessRightsTable {db} {
+ set err [catch {db eval {CREATE TABLE AccessRightsTable(actionname text, instructor integer, ta integer, student integer, guest integer)} } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 1
+ }
+ # guest should have no rights make sure that 0 is evereywhere except logon
+ # actionname instructor ta student guest
+ AddAccessRightNonWeb logon 1 1 1 1
+ AddAccessRightNonWeb showgrades 1 1 1 0
+ AddAccessRightNonWeb sort 1 1 0 0
+ AddAccessRightNonWeb addcolumnrequest 1 1 0 0
+ AddAccessRightNonWeb addcolumn 1 1 0 0
+ AddAccessRightNonWeb deletecolumn 1 1 0 0
+ AddAccessRightNonWeb showcontrols 1 1 1 0
+ AddAccessRightNonWeb changegrades 1 1 0 0
+ AddAccessRightNonWeb updategrades 1 1 0 0
+ AddAccessRightNonWeb changecolumn 1 1 0 0
+ AddAccessRightNonWeb updatecolumn 1 1 0 0
+ AddAccessRightNonWeb logoff 1 1 1 0
+ AddAccessRightNonWeb changefirstname 1 0 0 0
+ AddAccessRightNonWeb changelastname 1 0 0 0
+ AddAccessRightNonWeb changeusername 1 0 0 0
+ AddAccessRightNonWeb userhidecolumn 1 1 1 0
+ AddAccessRightNonWeb userunhidecolumn 1 1 1 0
+ AddAccessRightNonWeb userhidegroup 1 0 0 0
+ AddAccessRightNonWeb userunhidegroup 1 0 0 0
+}
+
+proc htmlErrorMsg { msg } {
+ puts "<div class=\"errormsg\">error: $msg</div>"
+}
+
+proc htmlReplaceEmptyString { string } {
+ # empty string replaced with "---"
+ regsub {^$} $string "---" string
+ # white spaces only string replaced with "---"
+ regsub {^\s+$} $string "---" string
+ set string
+}
+
+proc htmlDBout {db permission_list user {sort_col {}}} {
+ array set permission $permission_list
+ global script_name
+ set defSortCol LastName
+
+ if { $sort_col == {} } {
+ set sort_col $defSortCol
+ dbg "empty sort col changed to $sort_col" 4
+ }
+ # testing for the existense of the sorting column
+ set eval_str [list SELECT * FROM GradesTable ORDER BY $sort_col]
+ set err [catch {db eval $eval_str } errStat]
+ if { $err } {
+ dbg $errStat 3
+ dbg "changing to default sorting column $defSortCol" 3
+ set sort_col $defSortCol
+ }
+
+ puts {<div class="gradestable">}
+ set show_header 1
+ # get names of all columns
+ set column_list [getColListFromTable GradesTable]
+ # set hidden column list
+ switch $permission(GroupName) {
+ instructor { set hidden_columns {} }
+ ta { set hidden_columns [list UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups IdNum] }
+ student { set hidden_columns [list FirstName LastName UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups IdNum SectionNum] }
+ guest { set hidden_columns $column_list }
+ default { set hidden_columns $column_list }
+ }
+ # add user hidden columns
+ set hidden_columns [concat $hidden_columns [SelectColValue4User UserHiddenColums $user]]
+ # remove hidden columns from sql request
+ foreach col $hidden_columns {
+ set column_list [removeElementFromList $col $column_list]
+ }
+ set sql_column_str [colList2sqlColStr $column_list]
+ # set users of what group user can see, i.e. set WHERE statement
+ set where_statement {}
+ switch $permission(GroupName) {
+ instructor {
+ # hide unwanted user groups
+ set user_groups_for_hide [SelectColValue4User UserHiddenGroups $user]
+ if {$user_groups_for_hide != {} } {
+ foreach grp $user_groups_for_hide {
+ if { $where_statement == {} } {
+ set where_statement "WHERE GroupName<>\"$grp\""
+ } else {
+ set where_statement [concat $where_statement "AND GroupName<>\"$grp\""]
+ }
+ }
+ }
+ }
+ ta { set where_statement "WHERE GroupName=\"student\"" }
+ student { set where_statement "WHERE UserName=\"$user\"" }
+ guest { dbg "Guest must not be allowed to set table view port. Aborting. This line is never executed" 0; exit }
+ default { dbg "Default must not be allowed to set table view port. Aborting. This line is never executed." 0; exit }
+ }
+ if { $sql_column_str ne "" } {
+ # get all allowed columns and rows
+ set eval_str [concat SELECT $sql_column_str FROM GradesTable $where_statement ORDER BY $sort_col]
+ set err [catch {
+ db eval $eval_str v {
+ if { $show_header } {
+ set show_header 0
+ puts {<table class="gradestable" border="1">}
+ puts "<tr>"
+ foreach col $v(*) {
+ # detect what column category it is
+ set category [SelectColValue4User $col _Col_Category_]
+ puts -nonewline "<th class=\"$category\"><a href=\"$script_name?action=sort&sortCol=$col\">$col</a>"
+ # below list has action and action_label pairs
+ set action_list {userhidecolumn hide}
+ switch $col {
+ FirstName { lappend action_list changefirstname "change first name" }
+ LastName { lappend action_list changelastname "change last name" }
+ UserName { lappend action_list changeusername "change user name" }
+ PasswordHash { }
+ UserHiddenColums { }
+ UserHiddenGroups { }
+ IdNum { }
+ GroupName { }
+ SectionNum { }
+ default {
+ lappend action_list changegrades "change grades" deletecolumn delete changecolumn "change column"
+ }
+ }
+ set separator {<br>}
+ foreach {act act_label} $action_list {
+ if { [isActionGranted $act $permission_list $user] } {
+ puts -nonewline "$separator<span class=\"controls\"><a href=\"$script_name?action=$act&columnname=[::ncgi::encode $col]\">$act_label</a></span>"
+ }
+ }
+ puts -nonewline "</th>"
+ puts ""
+ }
+ puts "</tr>"
+ puts "<tr>"
+ } else {
+ puts "<tr>"
+ }
+ foreach index $v(*) {
+ if { $index != "*" } {
+ # detect what column category it is
+ set category [SelectColValue4User $index _Col_Category_]
+ set col_value [htmlReplaceEmptyString $v($index)]
+ puts -nonewline "<td class=\"$category\">$col_value</td>"
+ }
+ }
+ puts "</tr>"
+ }
+ } errStat ]
+ if { $err } {
+ dbg "we should never be here if $sortCol exist in the table" 1
+ dbg $errStat 1
+ htmlErrorMsg $errStat
+ }
+ puts "</table>"
+ } else {
+ puts {There is no grades yet.}
+ }
+ puts {</div>}
+}
+
+proc htmlTop {permission_list} {
+ array set permission $permission_list
+ if { $permission(GroupName) == "guest" } {
+ askToLogin
+ } else {
+ Greetings
+ }
+
+}
+
+proc htmlFooter {permission_list} {
+ array set permission $permission_list
+ global VERSION
+ puts "<div class=\"footer\">"
+ puts "GradeBook $VERSION code is written by Eugeniy E. Mikhailov"
+ puts "</div>"
+}
+
+
+proc SelectColValue4User { colname user } {
+ set value {}
+ set eval_str "SELECT \"$colname\" FROM GradesTable where UserName=\"$user\""
+ set err [catch {
+ db eval $eval_str v {
+ set value $v($colname)
+ }
+ } errStat ]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+ return $value
+}
+
+proc Greetings {} {
+ global user password script_name
+
+ set FirstName UnknownFirstName
+ set LastName UnknownLastName
+
+ # get First and Last name info
+ set FirstName [SelectColValue4User FirstName $user]
+ set LastName [SelectColValue4User LastName $user]
+
+ puts "<div class=\"greetings\">"
+ puts "<span class=login_info>$FirstName $LastName</span>, you are logged in as <span class=login_info>$user</span>."
+ #puts "<a href=\"$script_name?action=logoff\">logoff</a>"
+ puts "</div>"
+
+}
+
+proc askToLogin {} {
+ global script_name
+ global user password
+ puts "<div class=\"login\">"
+ puts "Either you are here first time or you password and user name does not match. <br>"
+ puts "Please login <br>"
+ puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
+ puts "Login: <input type=\"text\" name=\"user\" value=\"$user\"><br>"
+ puts {Password: <input type="password" name="password"><br>}
+ puts {<input type="hidden" name="action" value="logon"/>}
+ puts {<input type="submit" value="Submit" />}
+ puts {</form>}
+ puts "</div>"
+}
+
+proc LogMeOn {} {
+ global user password
+ set user [::ncgi::value user guest]
+ set password [::ncgi::value password guest]
+ dbg "Logging in and setting cookies" 4
+ ::ncgi::setCookie -name user -value $user
+ ::ncgi::setCookie -name password -value $password
+}
+
+proc LogMeOff {} {
+ dbg "Logging off" 4
+ global user password
+ #set user guest
+ set password {}
+ #::ncgi::setCookie -name user -value $user
+ ::ncgi::setCookie -name password -value $password
+}
+
+proc SetSortColumn {} {
+ global sortCol
+ set sortCol [::ncgi::value sortCol LastName]
+ ::ncgi::setCookie -name sortCol -value $sortCol
+}
+
+proc isActionGranted { action permission_list user } {
+ array set permission $permission_list
+ if { $action == "defaultview" } {
+ # this one permitted to everyone
+ dbg "requested action $action for user $user is granted" 4
+ return 1;
+ }
+ if { ![info exist permission($action) ] } {
+ dbg "requested UNKNOWN action $action for user $user is not granted" 0
+ htmlErrorMsg "requested UNKNOWN action $action"
+ return 0;
+ }
+
+ if {$permission($action) } {
+ dbg "requested action $action for user $user is granted" 4
+ return 1;
+ } else {
+ dbg "requested action $action for user $user is not granted" 1
+ return 0;
+ }
+}
+
+proc ChoseAction {action permission_list user} {
+ array set permission $permission_list
+ dbg "requested action: $action" 1
+ if { [isActionGranted $action $permission_list $user] } {
+
+ switch $action {
+ sort { SetSortColumn; ChoseAction defaultview $permission_list $user }
+ addcolumn {
+ AddColumn $permission_list $user;
+ htmlDefaultView $permission_list $user
+ }
+ addcolumnrequest { AddColumnRequest $permission_list $user }
+ deletecolumn {
+ DeleteColumn $permission_list $user;
+ htmlDefaultView $permission_list $user
+ }
+ changegrades { ChangeGrades $permission_list $user }
+ updategrades { UpdateGrades $permission_list $user
+ htmlDefaultView $permission_list $user
+ }
+ changecolumn { ChangeColumn $permission_list $user }
+ updatecolumn { UpdateColumn $permission_list $user
+ htmlDefaultView $permission_list $user
+ }
+ showcontrols { ShowControls $permission_list $user }
+ userhidecolumn { UserHideColumn $permission_list $user
+ htmlDefaultView $permission_list $user }
+ userunhidecolumn { UserUnHideColumn $permission_list $user
+ htmlDefaultView $permission_list $user }
+ userhidegroup { UserHideGroup $permission_list $user
+ htmlDefaultView $permission_list $user }
+ userunhidegroup { UserUnHideGroup $permission_list $user
+ htmlDefaultView $permission_list $user }
+ showgrades { htmlGradesTable db $permission_list $user }
+ defaultview { htmlDefaultView $permission_list $user }
+ default { htmlErrorMsg "requested action <b>$action</b> is granted but not implemented yet" }
+ }
+ } else {
+ # this action is permitted to everyone by default
+ ChoseAction defaultview $permission_list $user
+ }
+}
+
+proc UserUnHideGroup { permission_list user } {
+ set groupname [::ncgi::value groupname {}]
+ set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user]
+ set currently_hidden_groups [removeElementFromList $groupname $currently_hidden_groups]
+ UpdateColValue4UserNameNonWeb UserHiddenGroups $user $currently_hidden_groups
+}
+proc UserHideGroup { permission_list user } {
+ set groupname [::ncgi::value groupname {}]
+ set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user]
+ lappend currently_hidden_groups $groupname
+ UpdateColValue4UserNameNonWeb UserHiddenGroups $user $currently_hidden_groups
+}
+
+proc UserHideColumn { permission_list user } {
+ set columnname [::ncgi::value columnname {}]
+ set currently_hidden_columns [SelectColValue4User UserHiddenColums $user]
+ lappend currently_hidden_columns $columnname
+ UpdateColValue4UserNameNonWeb UserHiddenColums $user $currently_hidden_columns
+}
+
+proc UserUnHideColumn { permission_list user } {
+ set columnname [::ncgi::value columnname {}]
+ set currently_hidden_columns [SelectColValue4User UserHiddenColums $user]
+ set currently_hidden_columns [removeElementFromList $columnname $currently_hidden_columns]
+ UpdateColValue4UserNameNonWeb UserHiddenColums $user $currently_hidden_columns
+}
+
+proc ChangeColumn { permission_list user } {
+ set columnname [::ncgi::value columnname {}]
+ set category "unset"
+ set category [SelectColValue4User $columnname _Col_Category_]
+ set maxpoints [SelectColValue4User $columnname _Max_Points_]
+
+ puts {<div class="add_new_column">}
+ puts "<form name=\"input\" method=\"post\" />"
+ set out_str {}
+ append out_str {Column Name: <input type="text" name="newcolumnname" value="} $columnname {"><br>}
+ puts $out_str
+ set out_str {}
+ append out_str {Category: <select name="category" value="} $category {">}
+ puts $out_str
+ # opt list has option name and corresponding text pairs
+ set opt_list [list \
+ unset --Select--\
+ Quiz Quiz\
+ HomeWork HomeWork\
+ LabReport LabReport\
+ MidTerm MidTerm\
+ FinalExam FinalExam\
+ ]
+ foreach {name txt} $opt_list {
+ set out_str {}
+ if { $name eq $category } {
+ append out_str {<option value="} $name {" selected>} $txt {</option>}
+ } else {
+ append out_str {<option value="} $name {">} $txt {</option>}
+ }
+
+ puts $out_str
+ }
+ puts {</select> <br>}
+ set out_str {}
+ append out_str {Max Point Possible:<input type="text" name="maxpointpossible" value="} $maxpoints {"> <br>}
+ puts $out_str
+ puts {<input type="hidden" name="action" value="updatecolumn"/>}
+ set out_str {}
+ append out_str {<input type="hidden" name="oldcolumnname" value="} $columnname {"/>}
+ puts $out_str
+ puts {<input type="submit" value="Submit" />}
+ puts {</form>}
+ puts {</div>}
+}
+
+proc UpdateColumn { permission_list user } {
+ set oldcolumnname [::ncgi::value oldcolumnname {}]
+ set newcolumnname [::ncgi::value newcolumnname {}]
+ set column_category [::ncgi::value category {}]
+ set maxpointpossible [::ncgi::value maxpointpossible {}]
+
+ # transform colnames to sql safe form
+ set oldcolumnname [ColName2SqlSafeForm $oldcolumnname]
+ set newcolumnname [ColName2SqlSafeForm $newcolumnname]
+
+ # first we update category and maxpointpossible values of the old columnname
+ UpdateColValue4UserNameNonWeb $oldcolumnname _Col_Category_ $column_category
+ UpdateColValue4UserNameNonWeb $oldcolumnname _Max_Points_ $maxpointpossible
+
+ if { $newcolumnname eq $oldcolumnname } {
+ # no need to mess with renaming
+ return
+ }
+ if { $newcolumnname == "" } {
+ htmlErrorMsg "empty column names are not permitted"
+ return
+ }
+ set eval_str [concat SELECT * FROM GradesTable ]
+ set err [catch {db eval $eval_str v {} } errStat]
+ set old_column_list $v(*)
+ # check if column with the suggested new name is already exist
+ foreach cname $old_column_list {
+ if { $cname eq $newcolumnname } {
+ htmlErrorMsg "The column name <b>$newcolumnname</b> is already exist"
+ return
+ }
+ }
+ # sqlite does not allow rename columns
+ # I will first create new column identical to the old one
+ AddColumnNonWeb $newcolumnname $column_category $maxpointpossible
+ set sql_str [concat UPDATE GradesTable SET \"$newcolumnname\"=\"$oldcolumnname\"]
+ set err [catch {db eval $sql_str } errStat]
+ # then delete the old one
+ DeleteColumnNonWeb $oldcolumnname
+}
+
+proc UpdateColValue4UserNameNonWeb { columnname username val } {
+ set sql_str [concat UPDATE GradesTable SET \"$columnname\"=\'$val\' where UserName=\"$username\"]
+ set err2 [catch {
+ db eval $sql_str
+ } errStat2 ]
+ if { $err2 } {
+ htmlErrorMsg $errStat2
+ dbg "the following error happen: $errStat2" 3
+ }
+}
+
+proc UpdateColValue4GroupNameNonWeb { columnname groupname val } {
+ set sql_str [concat UPDATE GradesTable SET \"$columnname\"=\'$val\' where GroupName=\"$groupname\"]
+ set err2 [catch {
+ db eval $sql_str
+ } errStat2 ]
+ if { $err2 } {
+ htmlErrorMsg $errStat2
+ dbg "the following error happen: $errStat2" 3
+ }
+}
+
+proc UpdateGrades { permission_list user } {
+ global script_name
+ set subaction [::ncgi::value subaction {}]
+ set columnname [::ncgi::value columnname {}]
+ set nv [::ncgi::nvlist]
+ array set colval $nv
+ if { $subaction eq "Submit" } {
+ set eval_str "SELECT UserName FROM GradesTable"
+ set err [catch {
+ db eval $eval_str v {
+ if { [info exist colval($v(UserName))] } {
+ UpdateColValue4UserNameNonWeb $columnname $v(UserName) $colval($v(UserName))
+ }
+ }
+ } errStat ]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+ }
+}
+
+proc ChangeGrades { permission_list user } {
+ global script_name
+ set columnname [::ncgi::value columnname {}]
+ if { $columnname != "" } {
+ # output only selected columns
+ set column_list {}
+ lappend column_list FirstName LastName UserName
+ lappend column_list \"$columnname\"
+ set sql_column_list [join $column_list ","]
+ puts {<div class="changegrades">}
+ puts {<div class="gradestable">}
+ puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
+ # output only selected columns
+ set eval_str "SELECT $sql_column_list FROM GradesTable WHERE UserName<>'_Col_Category_' AND UserName<>'_Max_Points_' AND GroupName='student' ORDER BY LastName"
+ set show_header 1
+ set err [catch {
+ db eval $eval_str v {
+ if { $show_header } {
+ set show_header 0
+ puts {<table class="gradestable" border="1">}
+ puts "<tr>"
+ foreach col $v(*) {
+ puts -nonewline "<th>$col</th>"
+ }
+ puts "<tr>"
+ } else {
+ puts "<tr>"
+ }
+ foreach index $v(*) {
+ if { $index != "*" } {
+ if { $index eq $columnname } {
+ #column with grade
+ puts "<th><input type=\"text\" name=\"$v(UserName)\" value=\"$v($columnname)\" size=5></th>"
+ } else {
+ puts -nonewline "<td>$v($index)</td>"
+ }
+ }
+ }
+ puts "</tr>"
+ }
+ } errStat ]
+ puts "</table>"
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+ puts {<input type="hidden" name="action" value="updategrades"/>}
+ puts [concat <input type="hidden" name="columnname" value="$columnname"/>]
+ puts {<input type="submit" name="subaction" value="Submit" />}
+ puts {<input type="submit" name="subaction" value="Cancel" />}
+ puts {</form>}
+ puts {</div>}
+ puts {</div>}
+ #puts "<a href=\"$script_name\">Cancel changes</a>"
+
+ } else {
+ htmlErrorMsg "empty column names are not permitted"
+ }
+}
+
+proc getColListFromTable { table } {
+ set eval_str [concat SELECT * FROM \'$table\' ]
+ set err [catch {db eval $eval_str v {} } errStat]
+ set old_column_list $v(*)
+ return $old_column_list
+}
+
+proc removeElementFromList { element2remove old_list } {
+ set new_list {}
+ foreach element $old_list {
+ if { $element2remove ne $element } {
+ lappend new_list $element
+ }
+ }
+ return $new_list
+}
+
+proc colList2sqlColStr { col_list } {
+ set sqlStr {}
+ foreach col $col_list {
+ if {$sqlStr ne ""} {
+ set sqlStr $sqlStr,\"$col\"
+ } else {
+ set sqlStr \"$col\"
+ }
+ }
+ return $sqlStr
+}
+
+
+proc DeleteColumnNonWeb { columnname } {
+ if { $columnname != "" } {
+
+ # removing the column name to be deleted from total list
+
+ set old_column_list [getColListFromTable GradesTable]
+ set new_column_list [removeElementFromList $columnname $old_column_list]
+ set sql_new_column_str [colList2sqlColStr $new_column_list]
+ set eval_str "BEGIN TRANSACTION;
+ CREATE TEMPORARY TABLE GradesTable_backup($sql_new_column_str);
+ INSERT INTO GradesTable_backup SELECT $sql_new_column_str FROM GradesTable;
+ DROP TABLE GradesTable;
+ CREATE TABLE GradesTable($sql_new_column_str);
+ INSERT INTO GradesTable SELECT $sql_new_column_str FROM GradesTable_backup;
+ DROP TABLE GradesTable_backup;
+ COMMIT;"
+ set err [catch {db eval $eval_str } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+ } else {
+ htmlErrorMsg "empty column names are not permitted"
+
+ }
+}
+
+proc DeleteColumn { permission_list user } {
+ global script_name
+ set columnname [::ncgi::value columnname {}]
+ DeleteColumnNonWeb $columnname
+}
+
+proc AddColumnNonWeb { columnname2add column_category maxpointpossible } {
+ if { $columnname2add != "" } {
+
+ set eval_str [concat ALTER TABLE GradesTable ADD \"$columnname2add\" text]
+ set err [catch {db eval $eval_str } errStat]
+ if { $err } {
+ htmlErrorMsg $errStat
+ dbg "the following error happen: $errStat" 3
+ }
+
+ UpdateColValue4UserNameNonWeb $columnname2add _Col_Category_ $column_category
+ UpdateColValue4UserNameNonWeb $columnname2add _Max_Points_ $maxpointpossible
+ } else {
+ htmlErrorMsg "empty column names are not permitted"
+ }
+}
+
+proc AddColumn { permission_list user } {
+ global script_name
+ set columnname2add [::ncgi::value columnname2add {}]
+ set column_category [::ncgi::value column_category {}]
+ set maxpointpossible [::ncgi::value maxpointpossible {}]
+ set columnname2add [ColName2SqlSafeForm $columnname2add]
+ AddColumnNonWeb $columnname2add $column_category $maxpointpossible
+}
+
+proc AddColumnRequest { permission_list user } {
+ global script_name
+ puts {<div class="add_new_column">}
+ puts "<form name=\"input\" method=\"post\" />"
+ puts {Column Name: <input type="text" name="columnname2add"><br>}
+ puts {Category: <select name="column_category">}
+ puts {<option value="unset">--Select--</option>}
+ puts {<option value="Quiz">Quiz</option>}
+ puts {<option value="HomeWork">HomeWork</option>}
+ puts {<option value="LabReport">LabReport</option>}
+ puts {<option value="MidTerm">MidTerm</option>}
+ puts {<option value="FinalExam">FinalExam</option>}
+ puts {</select> <br>}
+ puts {Max Point Possible:<input type="text" name="maxpointpossible"><br>}
+ puts {<input type="hidden" name="action" value="addcolumn"/>}
+ puts {<input type="submit" value="Submit" />}
+ puts {</form>}
+ puts {</div>}
+
+}
+
+proc ShowControls { permission_list user } {
+ array set permission $permission_list
+ global script_name
+ dbg "outputing contol list"
+ puts "<div class=\"controls\">"
+ set action_list [ list defaultview "Refresh" addcolumnrequest "Add Column" logoff "Logoff" ]
+ set separator { }
+ foreach {act act_label} $action_list {
+ if { [isActionGranted $act $permission_list $user] } {
+ puts -nonewline "$separator<span class=\"controls\"><a href=$script_name?action=$act>$act_label</a></span>"
+ }
+ }
+ puts "<br>"
+ # unhide user hidden columns actions
+ set currently_hidden_columns [SelectColValue4User UserHiddenColums $user]
+ if { $currently_hidden_columns ne "" } {
+ puts {Unhide columns: }
+ foreach col $currently_hidden_columns {
+ puts "<span class=\"controls\"><a href=\"$script_name?action=userunhidecolumn&columnname=[::ncgi::encode $col]\">$col</a></span>"
+ }
+ }
+ # hide user groups
+ set user_groups_for_hide [list inforow student ta instructor]
+ set currently_hidden_groups [SelectColValue4User UserHiddenGroups $user]
+ # remove already hidden group from offering
+ foreach grp $currently_hidden_groups {
+ set user_groups_for_hide [removeElementFromList $grp $user_groups_for_hide]
+ }
+ # output group to hide offering
+ if { [isActionGranted userhidegroup $permission_list $user] } {
+ if { $user_groups_for_hide ne "" } {
+ puts "<br>"
+ puts "HideGroup: "
+ foreach grp $user_groups_for_hide {
+ puts "<span class=\"controls\"><a href=\"$script_name?action=userhidegroup&groupname=[::ncgi::encode $grp]\">$grp</a></span>"
+ }
+ }
+ }
+ if { [isActionGranted userunhidegroup $permission_list $user] } {
+ if { $currently_hidden_groups ne "" } {
+ puts "<br>"
+ puts {Unhide groups: }
+ foreach grp $currently_hidden_groups {
+ puts "<span class=\"controls\"><a href=\"$script_name?action=userunhidegroup&groupname=[::ncgi::encode $grp]\">$grp</a></span>"
+ }
+ }
+ }
+
+ puts "</div>"
+}
+
+proc AccessGroupRights {db user password } {
+ dbg "access rights check for user: $user"
+ set PasswordHash [::md5::md5 -hex $password]
+ set eval_str [list SELECT GroupName FROM GradesTable WHERE UserName='$user' AND PasswordHash='$PasswordHash']
+ db eval $eval_str group_name_array {}
+ if { [ info exist group_name_array(GroupName) ] } {
+ set group $group_name_array(GroupName);
+ } else {
+ set group guest
+ }
+ dbg "Detected group is $group"
+ set eval_str [list SELECT actionname,$group FROM AccessRightsTable ]
+ set permission_list [list GroupName $group]
+ db eval $eval_str permissions { lappend permission_list $permissions(actionname) $permissions($group) }
+ dbg "permissions for user $user belonging to the group $group are: $permission_list"
+ return $permission_list
+}
+
+
+proc htmlGradesTable {db permission_list user} {
+ array set permission $permission_list
+ global sortCol
+ switch $permission(GroupName) {
+ guest { }
+ student { htmlDBout db $permission_list $user $sortCol}
+ ta { htmlDBout db $permission_list $user $sortCol}
+ instructor { htmlDBout db $permission_list $user $sortCol}
+ default { }
+ }
+}
+
+proc htmlDefaultView { permission_list user } {
+ ChoseAction showcontrols $permission_list $user
+ ChoseAction showgrades $permission_list $user
+}
+
+proc htmlHeader {} {
+puts {
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <meta http-equiv="Content-Type" content= "text/html; charset=us-ascii" />
+ <title>Grade Book</title>
+ <link rel="stylesheet" type="text/css" href="/~evmik/GradeBook.css" />
+</head>
+}
+}
+
+
+##################### end of procs ####################################
+
+# vim: ts=2 sw=2 foldmethod=indent:
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 15:36:26 +0000