aboutsummaryrefslogtreecommitdiff
path: root/GradeBook.tcl
diff options
context:
space:
mode:
authorEugeniy Mikhailov <evgmik@gmail.com>2011-01-24 21:34:30 -0500
committerEugeniy Mikhailov <evgmik@gmail.com>2011-01-24 21:34:30 -0500
commit494e45d4f08841bd9b2d56f3ced8418f8aa1d008 (patch)
treefedfed125ff9333b07d233bda2dc83dfa3eb7ae5 /GradeBook.tcl
parentb322dd885e403492f818a5110a9a7957a6b304ce (diff)
downloadGradeBook-494e45d4f08841bd9b2d56f3ced8418f8aa1d008.tar.gz
GradeBook-494e45d4f08841bd9b2d56f3ced8418f8aa1d008.zip
all shared procs move to library file
Ignore-this: 75e219cb44fc45e281a42d514cf2600f darcs-hash:20110125023430-067c0-ed0225f6b7d24c31e9f8eb4498a04191abf7f355.gz
Diffstat (limited to 'GradeBook.tcl')
-rwxr-xr-xGradeBook.tcl804
1 files changed, 2 insertions, 802 deletions
diff --git a/GradeBook.tcl b/GradeBook.tcl
index 078db4f..c33c2df 100755
--- a/GradeBook.tcl
+++ b/GradeBook.tcl
@@ -3,13 +3,12 @@
# vim:set ft=tcl: \
exec tclsh "$0" "$@"
-# internal version of this code
-set VERSION 1.0
-
package require sqlite3
package require ncgi
package require md5
+source ./GradeBook_lib.tcl
+
::ncgi::parse
# defaults
@@ -37,805 +36,6 @@ regsub -all {^/} $coursedbfname "" coursedbfname
set script_name "$script_name/$coursedbfname"
-# ########################## 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 ####################################
set timestamp [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"]