diff options
Diffstat (limited to 'GradeBook.tcl')
| -rwxr-xr-x | GradeBook.tcl | 804 |
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"] |