#!/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 2.0.0 # ######################################################################## # this should be in config file but these are reasonable defaults array set GradebookServerConfig [list \ icon_dir "/~evmik/icons" \ use_icons true \ grades_db_dir "./courses" \ passwords_db_file "./passwd.db" \ html_access_stats_url "/~evmik/grade_book_stats/" \ verbosity_level 100 \ log_file "log" \ ] # ######################################################################## # ########################## procs begin ################################# proc get_list_of_courses_db {} { # obtain list of all courses DB global GradebookServerConfig set grades_db_dir $GradebookServerConfig(grades_db_dir) set db_files_list [lsort [glob -tails -d ${grades_db_dir}/ *]] return $db_files_list } proc get_grading_scheme {} { # pair of letter grade and lower boundary for this grade # should be sorted in descended order! set grading_scheme [ list \ A 0.94 \ A- 0.90 \ B+ 0.87 \ B 0.84 \ B- 0.80 \ C+ 0.77 \ C 0.74 \ C- 0.70 \ D+ 0.67 \ D 0.64 \ D- 0.60 \ F 0.00 \ ] return $grading_scheme } # Grades category and their html names proc get_grades_category {} { set eval_str "SELECT CategoryName FROM GradesCategoryTable" set grades_category {} set err [catch { db eval $eval_str v { lappend grades_category $v(CategoryName) } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_critical } #set grades_category [list \ #"unset"\ #Quiz\ #HomeWork\ #LabReport\ #MidTerm\ #FinalExam\ #] return $grades_category } proc default_grades_category {} { set grades_category [list \ "unset"\ deleted\ 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" msg_level_critical dbg $errStat msg_level_critical 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" msg_level_info return false } set flag [SelectColvalueFromTable GradesCategoryTable NeedsTotal CategoryName $category] if { $flag } { return true } else { return false } } proc howManyGradesToDropForCategorySet { category } { if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category does not exists in the GradesCategoryTable, setting number of grades to drop to 0" msg_level_info return 0 } if { ![doesColumnExists NumberToDrop GradesCategoryTable] } { dbg "Do not have column NumberToDrop in the table GradesCategoryTable, setting number of grades to drop to 0" msg_level_info return 0 } set num [SelectColvalueFromTable GradesCategoryTable NumberToDrop CategoryName $category] if { ![string is double -strict $num] } { dbg "Number of grades to drop is not a number, returning 0" msg_level_info return 0 } if { ![string is integer -strict $num] } { set new_num [expr {round($num)}] dbg "Number of grades to drop is a double: $num, rounding it to $new_num" msg_level_info return $new_num } return $num } 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" msg_level_critical dbg $errStat msg_level_critical 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 listSum { l } { set sum 0 foreach e $l { set sum [ expr {$e + $sum}] } return $sum } proc dropTheLowestGrades {num_to_drop grades grades_max_possible} { # this procedure drops the grade with the lowest weight i.e. grade/max_grade # this is recursively called so 1st to check is exit condition if { $num_to_drop <= 0 } { set grades_sum [listSum $grades] set grades_max_sum [listSum $grades_max_possible] return [list $grades_sum $grades_max_sum] } # let's find the index of grade with the smallest grade/max_possible ratio set sm_ind -1; # non existing set smallest_ratio 10000; # something very big (larger than 1) set max_grade_for_smallest_ratio 0; # something small set i 0 foreach max_val $grades_max_possible { # grades with zero max_possible belong to bonuses # and it is impossible to calculate its weight anyway if { $max_val != 0 } { set grade [lindex $grades $i] set grade_weight [expr {1.0*$grade/$max_val}] } else { # we cannot divide by zero # so we just put something very big (much larger than 1) set grade_weight 1000000; # larger than default smallest_ratio } # update lowest contribution # FIXME: this logic is not as easy in the general case but it works # when max grades are about the same in the same category if { $grade_weight < $smallest_ratio } { # this easy case set sm_ind $i set smallest_ratio $grade_weight set max_grade_for_smallest_ratio $max_val } if { ($grade_weight == $smallest_ratio) && ($max_val > $max_grade_for_smallest_ratio) } { # for same grade_weight we should remove the one which has the largest max_val # this bust overall percentage for a student set sm_ind $i set smallest_ratio $grade_weight set max_grade_for_smallest_ratio $max_val } incr i } if { $sm_ind >=0 } { # let's remove lowest contribution set grades [lreplace $grades $sm_ind $sm_ind] set grades_max_possible [lreplace $grades_max_possible $sm_ind $sm_ind] } incr num_to_drop -1 return [dropTheLowestGrades $num_to_drop $grades $grades_max_possible] } proc calculteSumOfPointsForStudentInCategory { student category } { # these will be sum of students gains and max possible set gained_points 0 set max_points 0 ; # some assignment can be incomplete for a reasonable excuse (i.e. medical) # alternatively if the category has a flag of drop the lowest score it will be counted # as excused points as well set num_of_excuses 0 # these will contain values from not excused points set list_col_val {} set list_col_max {} # create the list of grades and respective maximums # but exclude excused grades from calculations set all_col_in($category) [ findColumnNamesInCategory $category ] foreach col $all_col_in($category) { set col_val [SelectColValue4User $col $student] set col_max_possible [getMaxPointsForColumn $col] if { $col_val eq "" } { set col_val 0 } # special cases for grades which are not a number: excuses or other notes set isItExcuse false 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 isItExcuse true incr num_of_excuses } 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 } } if { !$isItExcuse } { lappend list_col_val $col_val lappend list_col_max $col_max_possible } } set num_of_the_lowest_grades_to_drop [howManyGradesToDropForCategorySet $category] # excused points are counted towards lowest grades to be dropped set num_of_the_lowest_grades_to_drop [expr {$num_of_the_lowest_grades_to_drop - $num_of_excuses}] # note the following procedure is smart to not drop negative number of grades # and additionally counts the sum set ret [dropTheLowestGrades $num_of_the_lowest_grades_to_drop $list_col_val $list_col_max] set PointsSum(gained_points) [lindex $ret 0] set PointsSum(max_points) [lindex $ret 1] return [array get PointsSum] } proc calculteWeightedTotals { } { # we will do everything with in one transaction # otherwise I see performance degradation on some computers # when there are a lot if update statements begin_db_transaction set grades_category [ get_grades_category ] #global grades_category set all_column_names [getColListFromTable GradesTable] set students_list [ allUserNamesInGroup student ] set students_list [concat $students_list [ allUserNamesInGroup dropped ] ] # locate all column names of this category foreach category $grades_category { set flag_delete_CategoryWeightedTolal false set CategoryWeightedTolalName ${category}Total 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] 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" msg_level_info AddColumnNonWeb $CategoryWeightedTolalName weighted_column 0 } } else { set flag_delete_CategoryWeightedTolal true } if { [doesColumnExists $CategoryWeightedTolalName GradesTable] } { UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName _Max_Points_ $max_points($category) # calculated weighted sum for each student in this category foreach student $students_list { array set PointsSum [ calculteSumOfPointsForStudentInCategory $student $category ] set points_sum($category,$student) $PointsSum(gained_points) set max_points($category,$student) $PointsSum(max_points) 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) } } } else { set flag_delete_CategoryWeightedTolal true } if { $flag_delete_CategoryWeightedTolal && ([doesColumnExists $CategoryWeightedTolalName GradesTable]) } { DeleteColumnFromTable GradesTable $CategoryWeightedTolalName } } # 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" msg_level_info 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 max_points($category,$student) $PointsSum(max_points) 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." msg_level_info 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 # ending transaction end_db_transaction } proc grade_Category2html_name { category } { switch $category { "unset" {set html_name --Select--} deleted {set html_name Deleted} Quiz {set html_name Quiz} HomeWork {set html_name HomeWork} LabReport {set html_name LabReport} Participation {set html_name Participation} MidTerm {set html_name MidTerm} FinalExam {set html_name FinalExam} default {set html_name unknown} } return $html_name } proc dbg {msg {category msg_level_critical}} { global GradebookServerConfig switch $category { msg_level_info {set msg_header "Info:"; set level 6} msg_level_warning {set msg_header "Warning:"; set level 4} msg_level_dbg {set msg_header "Debug:"; set level 3} msg_level_log {set msg_header "Log:"; set level 2} msg_level_critical {set msg_header "Error:"; set level 1} default {set msg_header "Unknown:"; set level 0} } if { $level <= $GradebookServerConfig(verbosity_level) } { set fid [open $GradebookServerConfig(log_file) a+] puts $fid "$msg_header $msg" close $fid } } proc timestamp { } { return [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] } 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 {group_name {guest}} {id_number {}} {section_num {} } } { set eval_str [concat INSERT INTO GradesTable (FirstName, LastName, UserName, GroupName, IdNum, SectionNum) VALUES('$first_name', '$last_name', '$user_name', '$group_name', '$id_number', '$section_num')] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_critical } } 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" msg_level_critical } } 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" msg_level_critical } } 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" msg_level_critical } AddCourseInfoTableItem course_title "Title Unset" AddCourseInfoTableItem course_year "Year Unset" AddCourseInfoTableItem course_semester "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" msg_level_critical } 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\ 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" msg_level_info 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" msg_level_info AddGradesCategory db $category } UpdateColumnWithValueInTableWhere GradesCategoryTable CategoryWeight $weight CategoryName $category } proc ModifyNumberOfLowestGradesToDropGradesCategory {db category num} { if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category already does not exists in the GradesCategoryTable, creating it" msg_level_info AddGradesCategory db $category } UpdateColumnWithValueInTableWhere GradesCategoryTable NumberToDrop $num CategoryName $category } proc AddGradesCategory {db category} { if {[existsColumnWithRowvalueInTable GradesCategoryTable CategoryName $category ]} { dbg "Category: $category already exists in the GradesCategoryTable" msg_level_info 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" msg_level_critical } ModifyWeightForGradesCategory db $category 0 ModifyNeedsTotalForGradesCategory db $category false ModifyNumberOfLowestGradesToDropGradesCategory db $category 0 } proc CreateGradesCategoryTable {db} { # construct sql string for table creation set sql_str {CREATE TABLE GradesCategoryTable(CategoryName text, CategoryWeight float, NeedsTotal text, NumberToDrop integer)} set err [catch {db eval $sql_str } errStat] if { $err && ($errStat ne "table GradesCategoryTable already exists") } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_critical } 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 } else { ModifyNeedsTotalForGradesCategory db $v(CategoryName) false } if { [info exist colval($v(CategoryName)_NumberToDrop)] } { ModifyNumberOfLowestGradesToDropGradesCategory db $v(CategoryName) $colval($v(CategoryName)_NumberToDrop) } } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_critical } } calculteWeightedTotals } proc EditGradesCategories { db permission_list user } { global script_name lappend column_list CategoryName CategoryWeight NumberToDrop 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 "" } "NumberToDrop" { puts "" } default { puts -nonewline "" } } } } puts "" } } errStat ] puts "
$col
$v($index)
" if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_critical } 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" msg_level_critical } # 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 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" msg_level_critical } } 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" msg_level_critical } # 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 action2atributes { action_name } { # return list of action_name, text description, and icon name # for each action global GradebookServerConfig set icon_dir $GradebookServerConfig(icon_dir) case $action_name { userhidecolumn { set attrib [list $action_name "hide" $icon_dir/hide.png ]} changefirstname { set attrib [list $action_name "change first name" $icon_dir/edit.png ]} changelastname { set attrib [list $action_name "change last name" $icon_dir/edit.png ]} changeusername { set attrib [list $action_name "change user name" $icon_dir/edit.png ]} hidecolfromstudents { set attrib [list $action_name "hide from students" $icon_dir/students_unhide.png ]} unhidecolfromstudents { set attrib [list $action_name "show to students" $icon_dir/students_hide.png ]} changegrades { set attrib [list $action_name "change grades" $icon_dir/edit.png ]} deletecolumn { set attrib [list $action_name "delete" $icon_dir/delete_column.png ]} changecolumn { set attrib [list $action_name "change column" $icon_dir/tune.png ]} default { set attrib [list $action_name "unknown" $icon_dir/tbd.png ]} } return $attrib } proc number2letter_grade { num } { # grading_scheme MUST be sorted in descending order! # here we do proper percent rounding set num [expr {round(100.0*$num)/100.0}] set grading_scheme [get_grading_scheme] foreach {letter threshold} $grading_scheme { if { $num >= $threshold } { return $letter } } # should never reach this point if grading scheme set properly return "NA" } proc htmlDBout {db permission_list user {sort_col {}}} { array set permission $permission_list global GradebookServerConfig global script_name #global grades_category set grades_category [ get_grades_category ] set defSortCol LastName # testing for the existence of the sorting column if { ![doesColumnExists $sort_col GradesTable] } { dbg "changing to default sorting column $defSortCol" msg_level_info 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 GroupName UserHiddenColums UserHiddenGroups UserHiddenGradeCategories IdNum] } student { set hidden_columns [list UserName GroupName UserHiddenColums UserHiddenGroups UserHiddenGradeCategories IdNum SectionNum] } dropped { set hidden_columns [list UserName 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") } { switch $col { FirstName {; #nothing bad to see first name} LastName {; #nothing bad to see last name} default { 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" msg_level_critical; exit } default { dbg "Default must not be allowed to set table view port. Aborting. This line is never executed." msg_level_critical; exit } } if { $sql_column_str ne "" } { # assign type cast for different sort_col if { [SelectColValue4User $sort_col _Col_Category_] in [concat $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 "" # show max point values puts "" set eval_str_MP [concat SELECT $sql_column_str FROM GradesTable WHERE UserName=\"_Max_Points_\"] set errMaxPoints [catch { db eval $eval_str_MP v_MP { foreach c $v_MP(*) { if { $c in $hidden_columns } continue switch $c { "FirstName" {set MaxPointsStr "Max"} "LastName" {set MaxPointsStr "Possible"} "GroupName" {set MaxPointsStr ""} "UserName" {set MaxPointsStr "_Derived_"} default {set MaxPointsStr $v_MP($c)} } puts "" } } } errStat_MP ] if { $errMaxPoints } { dbg "we should never be here if UserName: _Max_Points_ exist in the table" msg_level_critical dbg $errStat_MP msg_level_critical htmlErrorMsg $errStat_MP } 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 } # calculate letter grade to Grand Total if { $index eq "Grand Total" } { set col_value_letter_grade [number2letter_grade $col_value] } # promote to percent format set col_value [format "%04.2f%%" [expr {100.* $col_value} ] ] # add letter grade to Grand Total if { $index eq "Grand Total" } { set col_value [ concat $col_value "=" $col_value_letter_grade ] } } 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" msg_level_critical dbg $errStat msg_level_critical htmlErrorMsg $errStat } puts "
$col" # below list has action and action_label pairs set action_list {userhidecolumn} switch $col { FirstName { lappend action_list changefirstname } LastName { lappend action_list changelastname } UserName { lappend action_list changeusername } 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 } else { lappend action_list unhidecolfromstudents } } } default { lappend action_list changegrades deletecolumn changecolumn if { [SelectColValue4User $col _Visible_To_Students_] eq "true" } { lappend action_list hidecolfromstudents } else { lappend action_list unhidecolfromstudents } } } } } set separator {
} foreach act $action_list { set attributes [action2atributes $act] set act_label [lindex $attributes 1] set act_icon [lindex $attributes 2] if { [isActionGranted $act $permission_list $user] } { if { $GradebookServerConfig(use_icons) } { puts -nonewline "$separator" puts -nonewline "\"$act_label\"" puts -nonewline "" } else { puts -nonewline "$separator" puts -nonewline "$act_label" puts -nonewline "" } } } puts -nonewline "
$MaxPointsStr
$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 html_Show_Classes_List {permission_list user} { # list available class DBs global GradebookServerConfig script_root_name puts "
" puts "Available classes are" puts "" puts "
" } proc htmlFooter {permission_list} { array set permission $permission_list global VERSION global GradebookServerConfig 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 by Eugeniy E. Mikhailov." puts "

Access statistics." 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 "

" puts "$CourseYear - $CourseSemester" puts "

" 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_requested 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 user_requested dbg "$user_requested which is identified as $user asked to reset the password" msg_level_log if { [SelectColValue4User UserName $user_requested] eq "" } { htmlErrorMsg "Sorry but user {$user_requested} is not registered in this class" dbg "{$user_requested} is not registered in this class" msg_level_info return } #reset password procedure goes here # FIXME sanitize email set newpassword [GenPassword] Set_New_Password_Non_Web $user_requested $newpassword SendNewPassword2User $user_requested $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 } { dbg "Sending password to user $user" msg_level_info 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" dbg "Something seems to have gone wrong during mailing the password for {$user}. Information about it: $::errorInfo" msg_level_critical } #now it is safe to delete temporary file if { [catch {file delete $tmp_msg_file} msg] } { dbg "Cannot delete file {$tmp_msg_file} with temporary password message for user {$user}" msg_level_critical } } proc LogMeOn {} { #more correctly set cookies global user_requested password set user_requested [::ncgi::value user guest] set password [::ncgi::value password guest] dbg "Logging in and setting cookies" msg_level_info ::ncgi::setCookie -name user -value $user_requested ::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" msg_level_info 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 dbg "$user requested action $action" msg_level_info if { $action == "defaultview" } { # this one permitted to everyone dbg "requested action $action for user $user is granted" msg_level_info return 1; } if { $action == "resetforgottenpassword" } { # this one permitted to everyone dbg "requested action $action for user $user is granted" msg_level_info return 1; } if { ![info exist permission($action) ] } { dbg "requested UNKNOWN action $action for user $user is not granted" msg_level_warning htmlErrorMsg "requested UNKNOWN action $action" return 0; } if {$permission($action) } { dbg "requested action $action for user $user is granted" msg_level_info return 1; } else { dbg "requested action $action for user $user is not granted" msg_level_info return 0; } } proc ChoseAction {action permission_list user} { array set permission $permission_list dbg "requested action: $action" msg_level_info 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 dbg "action $action isn not permitted for $user" msg_level_info } } 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 Set_New_Password_Non_Web {user newpassword} { global GradebookServerConfig if { $newpassword eq "" } { dbg "Attempt to set empty password which is not permitted" msg_level_info return } set password_hash [::md5::md5 -hex $newpassword] set err [catch { sqlite3 pdb $GradebookServerConfig(passwords_db_file) } errStat ] if { $err } { dbg "$errStat with filename $GradebookServerConfig(passwords_db_file)" msg_level_critical return } if { ![ is_User_Registered_in_Passwords_DB $user ] } { set sql_str [concat INSERT INTO PasswordsTable (UserName, PasswordHash) VALUES('$user', '$password_hash')] } else { set sql_str [concat UPDATE PasswordsTable SET \"PasswordHash\"=\'$password_hash\' where UserName=\"$user\"] } set err [catch { pdb eval $sql_str } errStat ] if { $err } { htmlErrorMsg $errStat dbg "the following error happen: $errStat" msg_level_warning } } 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 "" } { dbg "Attempt to set empty password which is not permitted" msg_level_info htmlErrorMsg "Empty passwords are not permitted" return } if { $subaction eq "Submit" } { Set_New_Password_Non_Web $user $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 set grades_category [ get_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] set needToRecalculateWeightedTotals false # first we update category and maxpointpossible values of the old columnname set old_column_category [SelectColValue4User $oldcolumnname _Col_Category_] if { $old_column_category ne $column_category } { UpdateColValue4UserNameNonWeb $oldcolumnname _Col_Category_ $column_category set needToRecalculateWeightedTotals true } set old_maxpointpossible [SelectColValue4User $oldcolumnname _Max_Points_] if { $old_maxpointpossible ne $maxpointpossible } { UpdateColValue4UserNameNonWeb $oldcolumnname _Max_Points_ $maxpointpossible set needToRecalculateWeightedTotals true } if { $needToRecalculateWeightedTotals } { calculteWeightedTotals } if { $newcolumnname eq $oldcolumnname } { # no need to mess with renaming return } if { $newcolumnname == "" } { htmlErrorMsg "empty column names are not permitted" return } RenameColumnNonWeb $oldcolumnname $newcolumnname } 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" msg_level_critical } } 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" msg_level_critical } } 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" msg_level_critical } else { 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" msg_level_critical } 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 RenameColumnNonWeb { oldcolumnname newcolumnname } { 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 set maxpointpossible 0 set column_category _dummy_ 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 DeleteColumnNonWeb { columnname } { DeleteColumnFromTable GradesTable $columnname } proc DeleteColumn { permission_list user } { global script_name set columnname [::ncgi::value columnname {}] # I decide against actual deletion # DeleteColumnNonWeb $columnname # Instead I will rename column and put it to the special category set tstamp [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"] set deleted_columnname [concat _deleted_ $tstamp $columnname] RenameColumnNonWeb $columnname $deleted_columnname # set column category to deleted one set old_column_category [SelectColValue4User $deleted_columnname _Col_Category_] set category_deleted deleted UpdateColValue4UserNameNonWeb $deleted_columnname _Col_Category_ $category_deleted UpdateColValue4UserNameNonWeb $deleted_columnname _Visible_To_Students_ false calculteWeightedTotals } 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" msg_level_critical } 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 if { $column_category ne "weighted_column" } { calculteWeightedTotals } } proc AddColumnRequest { permission_list user } { global script_name #global grades_category set grades_category [ get_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 set grades_category [ get_grades_category ] dbg "outputting contol list" msg_level_info 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 Create_Passwords_Table {} { dbg "Creating PasswordsTable" msg_level_info set err [catch {pdb eval {CREATE TABLE PasswordsTable(UserName text, PasswordHash text)} } errStat] if { $err } { dbg "While creating PasswordsTable the following error happen: $errStat" msg_level_critical } } proc is_User_Registered_in_Passwords_DB { user_requested } { # note the use of : instead of $ (this sqlite feature) set eval_str {SELECT UserName FROM PasswordsTable WHERE UserName=:user_requested} set err [catch { pdb eval $eval_str registered_user_names_array {} } errStat ] if { $err } { if { $errStat eq "no such table: PasswordsTable" } { Create_Passwords_Table } else { htmlErrorMsg "Problem accessing passwords database, please, contact system administrator" dbg "$errStat" msg_level_warning } } if { ![ info exist registered_user_names_array(UserName) ] } { dbg "$user_requested does not exist in the passwords DB" msg_level_info return false } return true } proc Authenticate_User { user_requested password } { # return the username of authentificated user or a guest like username global GradebookServerConfig set err [catch { sqlite3 pdb $GradebookServerConfig(passwords_db_file) } errStat ] if { $err } { htmlErrorMsg "Problem accessing passwords database, please, contact system administrator" dbg "$errStat with filename $GradebookServerConfig(passwords_db_file)" msg_level_critical return __non_existing_user__ } dbg "access rights check for user: $user_requested" msg_level_info set PasswordHash [::md5::md5 -hex $password] if { ![ is_User_Registered_in_Passwords_DB $user_requested ] } { pdb close return __non_existing_user__ } set eval_str [list SELECT UserName FROM PasswordsTable WHERE UserName=:user_requested AND PasswordHash=:PasswordHash] set err [catch { pdb eval $eval_str valid_user_name_array {} } errStat ] if { $err } { htmlErrorMsg "Problem accessing passwords database, please, contact system administrator" dbg "$errStat" msg_level_critical } if { [ info exist valid_user_name_array(UserName) ] } { dbg "Credentials match for $user_requested in the passwords DB" msg_level_info set user $valid_user_name_array(UserName); } else { dbg "Credentials for $user_requested do not match stored in password DB" msg_level_info set user __wrong_password_user__ } pdb close return $user } proc AccessGroupRights {db user } { dbg "access rights check for user: $user" msg_level_info set eval_str [list SELECT GroupName FROM GradesTable WHERE UserName='$user'] 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" msg_level_info 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" msg_level_info 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 } } proc htmlHeaderDBSelector {} { puts { Grade Books Selector } } ##################### end of procs #################################### # vim: ts=2 sw=2 foldmethod=indent: