aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xAddDummyUsers2db.tcl23
-rwxr-xr-xCreateCourseGradeBook.tcl100
-rwxr-xr-xGradeBook.tcl804
-rwxr-xr-xGradeBook_lib.tcl809
-rwxr-xr-xcsv2GradeBook.tcl1
5 files changed, 814 insertions, 923 deletions
diff --git a/AddDummyUsers2db.tcl b/AddDummyUsers2db.tcl
index 3eaeef2..2861b45 100755
--- a/AddDummyUsers2db.tcl
+++ b/AddDummyUsers2db.tcl
@@ -5,6 +5,7 @@ exec tclsh "$0" "$@"
package require sqlite3
package require md5
+source ./GradeBook_lib.tcl
set class [lindex $argv 0]
if { $class eq "" } {
@@ -15,28 +16,6 @@ set dbfile $class
sqlite3 db $dbfile
-proc dbg {msg {level 1}} {
- if { $level <=2 } {
- set fid [open log a+]
- puts $fid $msg
- close $fid
- }
-}
-
-proc htmlErrorMsg { msg } {
- puts "<div class=\"errormsg\">error: $msg</div>"
-}
-
-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
- }
-}
-
-
#AddUserNonWeb first_name last_name user_name password_hash group_name id_number section_num i
# dummy users
#AddUserNonWeb Ins "Instruch I" instructor [::md5::md5 -hex qwerty] instructor
diff --git a/CreateCourseGradeBook.tcl b/CreateCourseGradeBook.tcl
index bccc2f5..b521189 100755
--- a/CreateCourseGradeBook.tcl
+++ b/CreateCourseGradeBook.tcl
@@ -5,6 +5,7 @@ exec tclsh "$0" "$@"
package require sqlite3
package require md5
+source ./GradeBook_lib.tcl
if { $argc < 3 } {
puts {Usage:}
@@ -30,105 +31,6 @@ if { $argc >= 5 } {
sqlite3 db $dbfile
-proc dbg {msg {level 1}} {
- if { $level <=2 } {
- set fid [open log a+]
- puts $fid $msg
- close $fid
- }
-}
-
-proc htmlErrorMsg { msg } {
- puts "<div class=\"errormsg\">error: $msg</div>"
-}
-
-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
-
- #AddUserNonWeb Ins "Instruch I" instructor [::md5::md5 -hex qwerty] instructor
- # 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 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
- }
-}
-
CreateGradesTable db
CreateAccessRightsTable db
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"]
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:
diff --git a/csv2GradeBook.tcl b/csv2GradeBook.tcl
index 4fadb07..e5bf814 100755
--- a/csv2GradeBook.tcl
+++ b/csv2GradeBook.tcl
@@ -5,6 +5,7 @@ exec tclsh "$0" "$@"
package require sqlite3
package require md5
+source ./GradeBook_lib.tcl
set class [lindex $argv 0]
if { $class eq "" } {
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 22:27:44 +0000