#!/bin/sh # (C) 2010 by Eugeniy Mikhailov, # vim:set ft=tcl: \ exec tclsh "$0" "$@" # require Tcl version of at least 8.5 since I use 'ni' and 'in' in expressions for lists package require Tcl 8.5 source ./libBasicTableOperations.tcl # internal version of this code set VERSION 1.5.0 # Grades category and their html names set grades_category [list \ "unset"\ Quiz\ HomeWork\ LabReport\ MidTerm\ FinalExam\ ] # ########################## procs begin ################################# proc default_grades_category {} { set grades_category [list \ "unset"\ Quiz\ HomeWork\ LabReport\ Participation\ MidTerm\ FinalExam\ ] return $grades_category } proc getGradingWeights { } { set category_name_weight_list {} set eval_str [concat SELECT CategoryName,CategoryWeight FROM GradesCategoryTable] set err [catch { db eval $eval_str v { set category $v(CategoryName) set weight $v(CategoryWeight) if { ![string is double -strict $weight] } { htmlInfoMsg "weight for category: $category is not a number, setting it to 0" set weight 0 ModifyWeightForGradesCategory db $category 0 } lappend category_name_weight_list $category $weight } } errStat ] if { $err } { dbg "we should never be here if GradesCategoryTable exists" 1 dbg $errStat 1 htmlErrorMsg $errStat } return $category_name_weight_list } proc isCalculateTotalForCategorySet { category } { if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category does not exists in the GradesCategoryTable, setting CalculateTotal to false" 3 return false } set flag [SelectColvalueFromTable GradesCategoryTable NeedsTotal CategoryName $category] if { $flag } { return true } else { return false } } proc allUserNamesInGroup { group } { set eval_str [concat SELECT UserName FROM \'GradesTable\' WHERE GroupName == \'$group\'] set username_list {} set err [catch { db eval $eval_str v { lappend username_list $v(UserName) } } errStat ] if { $err } { dbg "we should never be here if UserName in GradesTable exists" 1 dbg $errStat 1 htmlErrorMsg $errStat } return $username_list } proc findColumnNamesInCategory { category } { set all_column_names [getColListFromTable GradesTable] set all_col_in($category) {} foreach col $all_column_names { # detect what column category it is set col_category [SelectColValue4User $col _Col_Category_] if { $col_category eq $category } { lappend all_col_in($category) $col } } return $all_col_in($category) } proc getMaxPointsForColumn { col } { set col_max [SelectColValue4User $col _Max_Points_] if { $col_max eq "" } { htmlInfoMsg "Column \{$col\} does not have Max Point value set" set col_max 0 } return $col_max } proc calculteMaxPointsInCategory { category } { set all_col_in($category) [ findColumnNamesInCategory $category ] set col_number_in_category [llength $all_col_in($category)] set max_points($category) 0 foreach col $all_col_in($category) { set col_max [getMaxPointsForColumn $col ] set max_points($category) [expr { $max_points($category) + $col_max }] } return [list $max_points($category) $col_number_in_category $all_col_in($category)] } proc calculteSumOfPointsForStudentInCategory { student category } { set all_col_in($category) [ findColumnNamesInCategory $category ] set gained_points 0 set excused_points 0 ; # some assignment can be incomplete for a reasonable excuse (i.e. medical) foreach col $all_col_in($category) { set col_val [SelectColValue4User $col $student] if { $col_val eq "" } { set col_val 0 } # special cases for grades which are not a number: excuses or other notes if { ![string is double -strict $col_val] } { if { [regexp -nocase -- {excuse} $col_val] } { # this grade will not be counted and maximum points for this student adjusted accordingly set col_val 0 set excused_points [expr { $excused_points + [getMaxPointsForColumn $col]}] } else { htmlInfoMsg "the user $student has a grade $col_val in column $col, which is not a number. Using 0 instead" set col_val 0 } } set gained_points [expr { $gained_points + $col_val}] } set PointsSum(gained_points) $gained_points set PointsSum(excused_points) $excused_points return [array get PointsSum] } proc calculteWeightedTotals { } { global grades_category set all_column_names [getColListFromTable GradesTable] # locate all column names of this category foreach category $grades_category { if { [isCalculateTotalForCategorySet $category] } { set all_col_in($category) [ findColumnNamesInCategory $category ] set tmpList [ calculteMaxPointsInCategory $category ] set max_points($category) [lindex $tmpList 0] set num_of_cols($category) [lindex $tmpList 1] set CategoryWeightedTolalName ${category}Total if { $num_of_cols($category) >= 2 } { # no weighted total column created for categories which do no have at least 2 columns # check if Weighted Category Column exists if { $CategoryWeightedTolalName ni $all_column_names } { dbg "Column $CategoryWeightedTolalName does not exist, will create it now" 1 AddColumnNonWeb $CategoryWeightedTolalName weighted_column 0 } } if { [doesColumnExists $CategoryWeightedTolalName GradesTable] } { UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName _Max_Points_ $max_points($category) # calculated weighted sum for each student in this category set students_list [ allUserNamesInGroup student ] set students_list [concat $students_list [ allUserNamesInGroup dropped ] ] foreach student $students_list { array set PointsSum [ calculteSumOfPointsForStudentInCategory $student $category ] set points_sum($category,$student) $PointsSum(gained_points) set excused_points($category,$student) $PointsSum(excused_points) set max_points($category,$student) [expr { $max_points($category) - $excused_points($category,$student)}] if { $max_points($category,$student) != 0 } { # normalizing set points_sum($category,$student) [expr { 1. * $points_sum($category,$student) / $max_points($category,$student) } ] } UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName $student $points_sum($category,$student) } } } } # now calculation of weighted grand total set grand_total_col_name "Grand Total" if { $grand_total_col_name ni $all_column_names } { dbg "Column $grand_total_col_name does not exist, will create it now" 1 AddColumnNonWeb $grand_total_col_name weighted_column 0 } foreach student $students_list { set grand_total($student) 0 foreach {category weight} [getGradingWeights] { if { ![info exist max_points($category)] } { set tmpList [ calculteMaxPointsInCategory $category ] set max_points($category) [lindex $tmpList 0] } if { ![info exist points_sum($category,$student)] } { array set PointsSum [ calculteSumOfPointsForStudentInCategory $student $category ] set points_sum($category,$student) $PointsSum(gained_points) set excused_points($category,$student) $PointsSum(excused_points) set max_points($category,$student) [expr { $max_points($category) - $excused_points($category,$student)}] if { $max_points($category,$student) != 0 } { # normalizing set points_sum($category,$student) [expr { 1. * $points_sum($category,$student) / $max_points($category,$student) } ] } } if { $max_points($category,$student) == 0} { dbg "Category: $category has 0 for total maximum points. Skipping it." 4 continue } set grand_total($student) [ expr { $grand_total($student) + $weight*$points_sum($category,$student) } ] } UpdateColValue4UserNameNonWeb $grand_total_col_name $student $grand_total($student) } set max_weighted_sum 0 foreach {category weight} [getGradingWeights] { set max_weighted_sum [ expr {$max_weighted_sum +$weight} ] } UpdateColValue4UserNameNonWeb $grand_total_col_name _Max_Points_ $max_weighted_sum } proc grade_Category2html_name { category } { switch $category { "unset" {set html_name --Select--} Quiz {set html_name Quiz} HomeWork {set html_name HomeWork} LabReport {set html_name LabReport} MidTerm {set html_name MidTerm} FinalExam {set html_name FinalExam} default {set html_name unknown} } return $html_name } proc grade_Category2html_name { category } { switch $category { "unset" {set html_name --Select--} Quiz {set html_name Quiz} HomeWork {set html_name HomeWork} LabReport {set html_name LabReport} MidTerm {set html_name MidTerm} FinalExam {set html_name FinalExam} default {set html_name unknown} } return $html_name } 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 AddCourseInfoTableItem { item value } { set eval_str [concat INSERT INTO CourseInfoTable (Item, Value) VALUES('$item', '$value') ] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } proc UpdateCourseInfoTableItem { item value } { set sql_str [concat UPDATE CourseInfoTable SET \"Value\"=\'$value\' where Item=\"$item\"] set err2 [catch { db eval $sql_str } errStat2 ] if { $err2 } { htmlErrorMsg $errStat2 dbg "the following error happen: $errStat2" 3 } } proc CreateCourseInfoTable {db} { set err [catch {db eval {CREATE TABLE CourseInfoTable(Item text, Value text)} } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 1 } AddCourseInfoTableItem course_title "Unset" AddCourseInfoTableItem course_year "Unset" AddCourseInfoTableItem course_semester "Unset" } proc SelectItemFromCourseInfoTable { item } { set value {} set eval_str "SELECT \"Value\" FROM CourseInfoTable where Item=\"$item\"" set err [catch { db eval $eval_str v { set value $v(Value) } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } return $value } proc GetDefaultGradesTableColumn {} { # this is the list of crucial GradesTable columns # column name and type set l [list \ FirstName text\ LastName text\ UserName text\ PasswordHash text\ GroupName text\ UserHiddenColums text\ UserHiddenGroups text\ UserHiddenGradeCategories text\ IdNum text\ SectionNum text\ ] return $l } proc ModifyNeedsTotalForGradesCategory {db category flag} { if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category does not exists in the GradesCategoryTable, creating it" 3 AddGradesCategory db $category } UpdateColumnWithValueInTableWhere GradesCategoryTable NeedsTotal $flag CategoryName $category } proc ModifyWeightForGradesCategory {db category weight} { if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category already does not exists in the GradesCategoryTable, creating it" 3 AddGradesCategory db $category } UpdateColumnWithValueInTableWhere GradesCategoryTable CategoryWeight $weight CategoryName $category } proc AddGradesCategory {db category} { if {[existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category already exists in the GradesCategoryTable" 3 return } set eval_str [concat INSERT INTO GradesCategoryTable (CategoryName) VALUES('$category')] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } ModifyWeightForGradesCategory db $category 0 ModifyNeedsTotalForGradesCategory db $category false } proc CreateGradesCategoryTable {db} { # construct sql string for table creation set sql_str {CREATE TABLE GradesCategoryTable(CategoryName text, CategoryWeight float, NeedsTotal text)} set err [catch {db eval $sql_str } errStat] if { $err && ($errStat ne "table GradesCategoryTable already exists") } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 1 } foreach category [default_grades_category] { AddGradesCategory db $category } } proc UpdateGradesCategores { db permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set nv [::ncgi::nvlist] array set colval $nv if { $subaction eq "Cancel" } { return } if { $subaction eq "Submit" } { set eval_str "SELECT CategoryName FROM GradesCategoryTable" set err [catch { db eval $eval_str v { if { [info exist colval($v(CategoryName)_weight)] } { ModifyWeightForGradesCategory db $v(CategoryName) $colval($v(CategoryName)_weight) } if { [info exist colval($v(CategoryName)_needs_total)] } { # check box existance means it set to true ModifyNeedsTotalForGradesCategory db $v(CategoryName) true } } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } } calculteWeightedTotals } proc EditGradesCategories { db permission_list user } { global script_name lappend column_list CategoryName CategoryWeight NeedsTotal set sql_column_list [join $column_list ","] puts {
} puts {
} puts "
" # output only selected columns set eval_str "SELECT $sql_column_list FROM GradesCategoryTable" set show_header 1 set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { puts -nonewline "" } puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { switch $index { "CategoryWeight" { puts "" } "NeedsTotal" { if { $v(NeedsTotal) eq "true" } { set checkbox_flag "checked" } else { set checkbox_flag "" } puts "" } default { puts -nonewline "" } } } } puts "" } } errStat ] puts "
$col
$v($index)
" if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } puts {} puts {} puts {} puts {
} puts {
} puts {
} #puts "Cancel changes" } proc CreateGradesTable {db} { # construct sql string for table creation set sql_str {CREATE TABLE GradesTable(} set flag_firsttime true foreach {col coltype} [GetDefaultGradesTableColumn] { if { $flag_firsttime} { set flag_firsttime false set sql_str [concat $sql_str $col $coltype] } else { set sql_str [concat $sql_str , $col $coltype] } } set sql_str [concat $sql_str )] puts $sql_str set err [catch {db eval $sql_str } 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 {} {} _Visible_To_Students_ {} 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 dropped_student_right guest_right } { set eval_str [concat INSERT INTO AccessRightsTable (actionname, instructor, ta, student, dropped, guest) VALUES('$action', '$instructor_right', '$ta_right', '$student_right', '$dropped_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, dropped 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 dropped guest AddAccessRightNonWeb logon 1 1 1 1 1 AddAccessRightNonWeb showgrades 1 1 1 1 0 AddAccessRightNonWeb sort 1 1 0 0 0 AddAccessRightNonWeb addcolumnrequest 1 1 0 0 0 AddAccessRightNonWeb addcolumn 1 1 0 0 0 AddAccessRightNonWeb deletecolumn 1 1 0 0 0 AddAccessRightNonWeb showcontrols 1 1 1 1 0 AddAccessRightNonWeb changegrades 1 1 0 0 0 AddAccessRightNonWeb updategrades 1 1 0 0 0 AddAccessRightNonWeb edit_grades_categories 1 0 0 0 0 AddAccessRightNonWeb update_grades_categories 1 0 0 0 0 AddAccessRightNonWeb changecolumn 1 1 0 0 0 AddAccessRightNonWeb updatecolumn 1 1 0 0 0 AddAccessRightNonWeb logoff 1 1 1 1 0 AddAccessRightNonWeb changefirstname 1 0 0 0 0 AddAccessRightNonWeb changelastname 1 0 0 0 0 AddAccessRightNonWeb changeusername 1 0 0 0 0 AddAccessRightNonWeb userhidecolumn 1 1 1 1 0 AddAccessRightNonWeb userunhidecolumn 1 1 1 1 0 AddAccessRightNonWeb userhidegroup 1 0 0 0 0 AddAccessRightNonWeb userunhidegroup 1 0 0 0 0 AddAccessRightNonWeb userhidegradecategory 1 0 0 0 0 AddAccessRightNonWeb userunhidegradecategory 1 0 0 0 0 AddAccessRightNonWeb editcourseinfo 1 0 0 0 0 AddAccessRightNonWeb updatecourseinfo 1 0 0 0 0 AddAccessRightNonWeb editnewuserinfo 1 0 0 0 0 AddAccessRightNonWeb addnewuserinfo 1 0 0 0 0 AddAccessRightNonWeb choosenewpassword 1 1 1 1 0 AddAccessRightNonWeb setnewpassword 1 1 1 1 0 AddAccessRightNonWeb changegroupname 1 0 0 0 0 AddAccessRightNonWeb setgroupname 1 0 0 0 0 AddAccessRightNonWeb hidecolfromstudents 1 1 0 0 0 AddAccessRightNonWeb unhidecolfromstudents 1 1 0 0 0 AddAccessRightNonWeb resetforgottenpassword 0 0 0 0 1 } proc htmlErrorMsg { msg } { puts "
error: $msg
" } proc htmlInfoMsg { msg } { puts {
} puts "$msg" puts {
} } 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 global grades_category 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 [concat 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 {
} 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 UserHiddenGradeCategories IdNum] } student { set hidden_columns [list FirstName LastName UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups UserHiddenGradeCategories IdNum SectionNum] } dropped { set hidden_columns [list FirstName LastName UserName PasswordHash GroupName UserHiddenColums UserHiddenGroups UserHiddenGradeCategories 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] } # check which GradesCategory user does not want to see set UserHiddenGradeCategories [concat $hidden_columns [SelectColValue4User UserHiddenGradeCategories $user]] foreach col $column_list { if { [SelectColValue4User $col _Col_Category_] in $UserHiddenGradeCategories } { set column_list [removeElementFromList $col $column_list] } if { ( ($permission(GroupName) eq "student") || ($permission(GroupName) eq "dropped") ) && ( [SelectColValue4User $col _Visible_To_Students_] ne "true") } { set column_list [removeElementFromList $col $column_list] } } # add UserName column since a lot depends on it knowledge if {{UserName} ni $column_list} { lappend column_list UserName } 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\"" } dropped { 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 "" } { # assign type cast for different sort_col if { [SelectColValue4User $sort_col _Col_Category_] in [list $grades_category weighted_column]} { set ordered_by_str [concat CAST(\"$sort_col\" AS REAL)] } else { set ordered_by_str \"$sort_col\" } #get all allowed columns and rows set eval_str [concat SELECT $sql_column_str FROM GradesTable $where_statement ORDER BY $ordered_by_str] set err [catch { db eval $eval_str v { if { $show_header } { set show_header 0 puts {} puts "" foreach col $v(*) { if { $col in $hidden_columns } continue # detect what column category it is set category [SelectColValue4User $col _Col_Category_] puts -nonewline "" puts "" } puts "" puts "" } else { puts "" } if { [info exist v(UserName)] } { set user_shown [htmlReplaceEmptyString $v(UserName)] } else { set user_shown "_UNSET_" } foreach index $v(*) { if { $index in $hidden_columns } continue if { $index != "*" } { # detect what column category it is set category [SelectColValue4User $index _Col_Category_] set max_points [SelectColValue4User $index _Max_Points_] set col_value $v($index) if { ([SelectColValue4User GroupName $user_shown] ne "inforow") && ($category eq "weighted_column") && ($max_points != 0) } { if { $col_value eq "" } { set col_value 0 } # promote to percent format set col_value [format "%.1f" [expr {100.* $col_value} ] ] set col_value [concat $col_value "%"] } set col_value [htmlReplaceEmptyString $col_value] switch $index { GroupName { if { [isActionGranted changegroupname $permission_list $user] && ($user_shown ne "_UNSET_") } { set action_html_code "$separatorChange" } else { set action_html_code {} } puts -nonewline "" } default {puts -nonewline ""} } } } puts "" } } errStat ] if { $err } { dbg "we should never be here if $sortCol exist in the table" 1 dbg $errStat 1 htmlErrorMsg $errStat } puts "
$col" # 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 { } UserHiddenGradeCategories { } IdNum { } GroupName { } SectionNum { } default { switch $category { "weighted_column" { # modify actions for weighted_column if { $permission(GroupName) eq "instructor" } { if { [SelectColValue4User $col _Visible_To_Students_] eq "true" } { lappend action_list hidecolfromstudents "hide from students" } else { lappend action_list unhidecolfromstudents "show to students" } } } default { lappend action_list changegrades "change grades" deletecolumn delete changecolumn "change column" if { [SelectColValue4User $col _Visible_To_Students_] eq "true" } { lappend action_list hidecolfromstudents "hide from students" } else { lappend action_list unhidecolfromstudents "show to students" } } } } } set separator {
} foreach {act act_label} $action_list { if { [isActionGranted $act $permission_list $user] } { puts -nonewline "$separator$act_label" } } puts -nonewline "
$col_value $action_html_code$col_value
" } else { puts {There is no grades yet.} } puts {
} } proc htmlTop {permission_list} { ClassInfoHtml array set permission $permission_list if { $permission(GroupName) == "guest" } { askToLogin } else { Greetings } } proc htmlFooter {permission_list} { array set permission $permission_list global VERSION global execution_start_time set execution_end_time [clock microseconds] set execution_time [ format "%.3g" [expr { ($execution_end_time - $execution_start_time)/1e6}] ] puts "
" puts "Execution time $execution_time seconds.
" puts "GradeBook $VERSION code is written by Eugeniy E. Mikhailov" puts "
" } proc SelectColValue4User { colname user } { return [SelectColvalueFromTable GradesTable $colname UserName $user] } proc ClassInfoHtml {} { set CourseTitle [SelectItemFromCourseInfoTable course_title] set CourseYear [SelectItemFromCourseInfoTable course_year] set CourseSemester [SelectItemFromCourseInfoTable course_semester] puts "
" puts "

Course grades for $CourseTitle

" puts "

$CourseYear

" puts "

$CourseSemester

" puts "
" } 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 "
" puts ", you are logged in as ." #puts "logoff" puts "
" } proc askToLogin {} { global script_name global user password puts "
" puts "Either you are here first time or you password and user name does not match.
" puts "Please login
" puts "
" puts "Login (email):
" puts {Password:
} puts {} puts {} puts {
} puts {If you don not know your password, fill in login box and push } puts {
} puts "
" } proc ResetForgottenPassword { permission_list user } { global script_name if { [SelectColValue4User UserName $user] eq "" } { htmlErrorMsg "Cannot reset password for unknown user {$user}" return } #reset password procedure goes here set newpassword [GenPassword] UpdateColValue4UserNameNonWeb PasswordHash $user [::md5::md5 -hex $newpassword] SendNewPassword2User $user $newpassword } proc GenPassword { } { set password_chars "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" set len [string length $password_chars] set i 1 set newpassword {} while { $i <= 8 } { incr i 1 set indx [expr {int(rand()*$len)}] set newchar [string index $password_chars $indx] append newpassword $newchar } return $newpassword } proc SendNewPassword2User { user password } { set CourseTitle [SelectItemFromCourseInfoTable course_title] set FirstName [SelectColValue4User FirstName $user] set tmp_msg_file /tmp/tmp_msg4user_$user set fp [open $tmp_msg_file w] puts $fp "Dear ${FirstName}," puts $fp "Your password to access $CourseTitle grades is" puts $fp "------------------------------------------" puts $fp "$password" puts $fp "------------------------------------------" close $fp if { [catch {exec mail -s "New password for $CourseTitle" $user < $tmp_msg_file} msg ] } { htmlErrorMsg "Something seems to have gone wrong during mailing the password. Information about it: $::errorInfo" } #now it is safe to delete temporary file file delete $tmp_msg_file } 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 set subaction [::ncgi::value subaction {}] if { $subaction eq "Reset password" } { return resetforgottenpassword } return defaultview } 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 } hidecolfromstudents { HideColumnFromStudents $permission_list $user htmlDefaultView $permission_list $user } unhidecolfromstudents { UnHideColumnFromStudents $permission_list $user htmlDefaultView $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 } userhidegradecategory { UserHideGradeCategory $permission_list $user htmlDefaultView $permission_list $user } userunhidegradecategory { UserUnHideGradeCategory $permission_list $user htmlDefaultView $permission_list $user } showgrades { htmlGradesTable db $permission_list $user } edit_grades_categories { EditGradesCategories db $permission_list $user } update_grades_categories { UpdateGradesCategores db $permission_list $user htmlDefaultView $permission_list $user } editcourseinfo { EditCourseInfo db $permission_list $user } updatecourseinfo { UpdateCourseInfo db $permission_list $user htmlDefaultView $permission_list $user } editnewuserinfo { EditNewUserInfo db $permission_list $user } addnewuserinfo { AddNewUserInfo db $permission_list $user htmlDefaultView $permission_list $user } choosenewpassword { ChooseNewPassword db $permission_list $user } setnewpassword { SetNewPassword db $permission_list $user htmlDefaultView $permission_list $user } resetforgottenpassword { ResetForgottenPassword $permission_list $user } changegroupname { ChangeGroupName $permission_list $user } setgroupname { SetGroupName $permission_list $user htmlDefaultView $permission_list $user } defaultview { htmlDefaultView $permission_list $user } default { htmlErrorMsg "requested action $action is granted but not implemented yet" } } } else { # this action is permitted to everyone by default #ChoseAction defaultview $permission_list $user } } proc ChangeGroupName {permission_list user } { global script_name set modified_user [::ncgi::value user2modify {}] set current_group_name [SelectColValue4User GroupName $modified_user] set FirstName [SelectColValue4User FirstName $modified_user] set LastName [SelectColValue4User LastName $modified_user] puts "
" puts "New group name for $FirstName $LastName with user name $modified_user" puts "
" puts {GroupName:
} puts {} puts "" puts {} puts {} puts {
} puts "
" } proc SetGroupName { permission_list user } { set subaction [::ncgi::value subaction {}] set modified_user [::ncgi::value user2modify {}] set new_group_name [::ncgi::value groupname {}] if { $subaction eq "Cancel" } { return } if { $new_group_name eq "" } { htmlErrorMsg "Empty groupname are not permitted" return } if { $subaction eq "Submit" } { UpdateColValue4UserNameNonWeb GroupName $modified_user $new_group_name } } proc ChooseNewPassword {db permission_list user } { global script_name puts "
" puts "
" puts "Please type new password:
" puts {} puts {} puts {} puts {
} puts "
" } proc SetNewPassword {db permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set newpassword [::ncgi::value newpassword {}] if { $subaction eq "Cancel" } { return } if { $newpassword eq "" } { htmlErrorMsg "Empty passwords are not permitted" return } if { $subaction eq "Submit" } { UpdateColValue4UserNameNonWeb PasswordHash $user [::md5::md5 -hex $newpassword] } } proc AddNewUserInfo {db permission_list user } { set subaction [::ncgi::value subaction {}] set first_name [::ncgi::value first_name {}] set last_name [::ncgi::value last_name {}] set login [::ncgi::value login {}] set id_number [::ncgi::value id_number {}] set section_number [::ncgi::value section_number {}] set group_name [::ncgi::value group_name {}] if { $subaction eq "Cancel" } { return } if { $login eq "" } { htmlErrorMsg "Empty login names are not permitted" return } if { [SelectColValue4User UserName $login] ne "" } { htmlErrorMsg "User with login $login already exists" return } set permitted_groups [list instructor ta student guest] if { $subaction eq "Submit" } { if { $group_name ni $permitted_groups } { htmlInfoMsg "Unknown group name {$group_name} replaced with {guest}." set group_name guest } AddUserNonWeb $first_name $last_name $login {} $group_name $id_number $section_number } } proc EditNewUserInfo {db permission_list user } { global script_name puts "
" puts "
" puts "First Name:
" puts "Last Name:
" puts "Login (email):
" puts "Id Number:
" puts "Section Number:
" puts "Group Name:
" puts {} puts {} puts {} puts {
} puts "
" } proc EditCourseInfo {db permission_list user } { global script_name set CourseTitle [SelectItemFromCourseInfoTable course_title] set CourseYear [SelectItemFromCourseInfoTable course_year] set CourseSemester [SelectItemFromCourseInfoTable course_semester] puts "
" puts "
" puts "Course title:
" puts "Course year:
" puts "Course Semester:
" puts {} puts {} puts {} puts {
} puts "
" } proc UpdateCourseInfo { db permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set CourseTitle [::ncgi::value course_title {}] set CourseYear [::ncgi::value course_year {}] set CourseSemester [::ncgi::value course_semester {}] if { $subaction eq "Cancel" } { return } if { $subaction eq "Submit" } { UpdateCourseInfoTableItem course_title $CourseTitle UpdateCourseInfoTableItem course_year $CourseYear UpdateCourseInfoTableItem course_semester $CourseSemester } htmlInfoMsg "Please click Refresh to see updated course info." } proc UserHideGradeCategory { permission_list user } { set ctg_name [::ncgi::value grades_category {}] set currently_UserHiddenGradeCategories [SelectColValue4User UserHiddenGradeCategories $user] lappend currently_UserHiddenGradeCategories $ctg_name UpdateColValue4UserNameNonWeb UserHiddenGradeCategories $user $currently_UserHiddenGradeCategories } proc UserUnHideGradeCategory { permission_list user } { set ctg_name [::ncgi::value grades_category {}] set currently_UserHiddenGradeCategories [SelectColValue4User UserHiddenGradeCategories $user] set currently_UserHiddenGradeCategories [removeElementFromList $ctg_name $currently_UserHiddenGradeCategories] UpdateColValue4UserNameNonWeb UserHiddenGradeCategories $user $currently_UserHiddenGradeCategories } 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 HideColumnFromStudents { permission_list user } { set columnname [::ncgi::value columnname {}] UpdateColValue4UserNameNonWeb $columnname _Visible_To_Students_ false } proc UnHideColumnFromStudents { permission_list user } { set columnname [::ncgi::value columnname {}] UpdateColValue4UserNameNonWeb $columnname _Visible_To_Students_ true } 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_] global grades_category puts {
} puts "
" set out_str {} append out_str {Column Name:
} puts $out_str set out_str {} append out_str {Category:
} set out_str {} append out_str {Max Point Possible:
} puts $out_str puts {} set out_str {} append out_str {} puts $out_str puts {} puts {
} puts {
} } 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 calculteWeightedTotals 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 $newcolumnname 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 } } calculteWeightedTotals } 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 {
} puts {If student have excuse for the grade to be excluded, use keyword excuse in conjunction with a reason.} puts {
} puts {For example : "medical excuse".} puts {
} puts "
" # 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 {} puts "" foreach col $v(*) { puts -nonewline "" } puts "" } else { puts "" } foreach index $v(*) { if { $index != "*" } { if { $index eq $columnname } { #column with grade puts "" } else { puts -nonewline "" } } } puts "" } } errStat ] puts "
$col
$v($index)
" if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" 3 } puts {} puts [concat ] puts {} puts {} puts {
} puts {
} puts {
} #puts "Cancel changes" } else { htmlErrorMsg "empty column names are not permitted" } } proc removeElementFromList { element2remove old_list } { set new_list {} foreach element $old_list { if { $element2remove ne $element } { lappend new_list $element } } return $new_list } proc DeleteColumnNonWeb { columnname } { DeleteColumnFromTable GradesTable $columnname calculteWeightedTotals } proc DeleteColumn { permission_list user } { global script_name set columnname [::ncgi::value columnname {}] DeleteColumnNonWeb $columnname } proc AddColumnNonWeb { columnname2add column_category maxpointpossible {sql_type {text}} } { if { $columnname2add != "" } { set eval_str [concat ALTER TABLE GradesTable ADD \"$columnname2add\" $sql_type] 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 global grades_category puts {
} puts "
" puts {Column Name:
} puts {Category:
} puts {Max Point Possible:
} puts {} puts {} puts {
} puts {
} } proc ShowControls { permission_list user } { array set permission $permission_list global script_name global grades_category dbg "outputing contol list" puts "
" set action_list [ list \ defaultview "Refresh"\ addcolumnrequest "Add Column"\ editcourseinfo "Edit Course Info"\ editnewuserinfo "Add new user"\ choosenewpassword "Choose new password"\ edit_grades_categories "Edit Grades Categories and Weights"\ logoff "Logoff"\ ] set separator { } foreach {act act_label} $action_list { if { [isActionGranted $act $permission_list $user] } { puts -nonewline "$separator$act_label" } } puts "
" # 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 "$col" } } # hide user groups set user_groups_for_hide [list inforow student ta instructor dropped] 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 "
" puts "HideGroup: " foreach grp $user_groups_for_hide { puts "$grp" } } } if { [isActionGranted userunhidegroup $permission_list $user] } { if { $currently_hidden_groups ne "" } { puts "
" puts {Unhide groups: } foreach grp $currently_hidden_groups { puts "$grp" } } } # hide user grades category set grades_category_for_hide $grades_category set currently_hidden_grades_category [SelectColValue4User UserHiddenGradeCategories $user] # remove already hidden category from offering foreach grd_category $currently_hidden_grades_category { set grades_category_for_hide [removeElementFromList $grd_category $grades_category_for_hide] } # output grades category to hide offering if { [isActionGranted userhidegroup $permission_list $user] } { if { $grades_category_for_hide ne "" } { puts "
" puts "Hide grades in category: " foreach ctgry $grades_category_for_hide { puts "$ctgry" } } } if { [isActionGranted userunhidegroup $permission_list $user] } { if { $currently_hidden_grades_category ne "" } { puts "
" puts {Unhide grades in category: } foreach ctgry $currently_hidden_grades_category { puts "$ctgry" } } } puts "
" } 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} dropped { 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 { Grade Book } } ##################### end of procs #################################### # vim: ts=2 sw=2 foldmethod=indent: