#!/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 package require math::statistics source ./txtPlot.tcl source ./libBasicTableOperations.tcl # internal version of this code set VERSION 2.0.0 set sticky_colums_list [list FirstName LastName UserCount ] # ######################################################################## # this should be in config file but these are reasonable defaults array set GradebookServerConfig [list \ icon_dir "/~evmik/icons" \ use_icons true \ skipAplus true \ grades_db_dir "./courses" \ passwords_db_file "./passwd.db" \ html_access_stats_url "/~evmik/grade_book_stats/" \ verbosity_level 100 \ log_file "log" \ photo_album_base_url "https://bbphotos.wm.edu/idphotos" \ photo_album_cache "../grades_book_photos" \ photo_album_cache_url "/~evmik/grades_book_photos" \ photo_img_width 90 \ photo_img_height 90 \ ] # ######################################################################## # ########################## 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_default_grading_scheme {} { # pair of letter grade and lower boundary for this grade # should be sorted in descended order! set grading_scheme [ list \ A+ 100 \ 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 -100 \ ] return $grading_scheme } proc CreateGradingSchemeTable {db} { begin_db_transaction set err [catch {db eval {CREATE TABLE GradingSchemeTable(LetterGrade text, LowerCutoff real)} } errStat] if { $err} { if { $errStat ne "attempt to write a readonly database" } { htmlErrorMsg $errStat dbg "Could not create GradingSchemeTable: $errStat" msg_level_critical [lindex [info level 0] 0] } else { dbg "Could not create GradingSchemeTable: $errStat" msg_level_info [lindex [info level 0] 0] } end_db_transaction; return } foreach {letter cutoff} [get_default_grading_scheme] { set eval_str [concat INSERT INTO GradingSchemeTable (LetterGrade, LowerCutoff) VALUES('$letter', '$cutoff')] set err [catch {db eval $eval_str } errStat] if { $err } { htmlErrorMsg $errStat dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } end_db_transaction } proc get_grading_scheme {} { set grading_scheme {} set eval_str [concat SELECT LetterGrade,LowerCutoff FROM GradingSchemeTable] set err [catch { db eval $eval_str v { lappend grading_scheme $v(LetterGrade) $v(LowerCutoff) } } errStat ] if { $err } { set grading_scheme [get_default_grading_scheme] if { $errStat eq "no such table: GradingSchemeTable" } { CreateGradingSchemeTable db } else { htmlErrorMsg $errStat dbg "$errStat" msg_level_critical [lindex [info level 0] 0] } } return $grading_scheme } proc htmlEditLetterGradeRequest { permission_list user } { global script_name puts {
} puts {

} puts {Assigning normalized to 1 cutoffs for letter grades.} puts {

} puts {

} puts {If you want to disable "A+" make cutoff significantly higher than 1.} puts {

} puts {

} puts {For example, "A-" = 0.9 and "A" = 0.94 means that a student with score in the range [0.9, 0.94) gets "A-", and any score >= 0.94 gets "A".} puts {

} puts {
} puts "
" # table header puts {} puts "" foreach col {Letter Cutoff} { puts -nonewline "" } puts "" # the rest of the table foreach {letter cutoff} [get_grading_scheme] { puts "" puts -nonewline "" # column with cutoff puts "" puts "" } puts "
$col
$letter
" puts {} puts {} puts {} puts {
} puts {
} puts {
} } proc EditLetterGrade { permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set nv [::ncgi::nvlist] array set colval $nv if { $subaction eq "Submit" } { begin_db_transaction set eval_str [concat SELECT LetterGrade FROM GradingSchemeTable] set err [catch { db eval $eval_str v { if { [info exist colval($v(LetterGrade))] } { UpdateColumnWithValueInTableWhere GradingSchemeTable LowerCutoff $colval($v(LetterGrade)) LetterGrade $v(LetterGrade) } } } errStat ] end_db_transaction if { $err } { htmlErrorMsg $errStat dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } } # 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } #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\ PreLab \ LabReport\ Participation\ LogBook\ Presentation\ MidTerm\ FinalExam\ Note\ Info\ AdmissionScore\ ] 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 } } # some special category are just notes # no need to do stats on them set doNotNeedStats false switch $category { Note {set doNotNeedStats true; set col_val 0} Info {set doNotNeedStats true; set col_val 0} default { } } if { !($isItExcuse || $doNotNeedStats) } { 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] } { # weighted category always normilized to 1 UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName _Max_Points_ 1 #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]) } { end_db_transaction DeleteColumnFromTable GradesTable $CategoryWeightedTolalName begin_db_transaction } } # 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] { # some special category are just notes # no need to do stats on them set doNotNeedStats false switch $category { Note {set doNotNeedStats true} Info {set doNotNeedStats true} default { } } if { $doNotNeedStats } { continue } 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} PreLab {set html_name PreLab} LabReport {set html_name LabReport} LogBook {set html_name LogBook} Presentation {set html_name Presentation} Participation {set html_name Participation} MidTerm {set html_name MidTerm} FinalExam {set html_name FinalExam} Note {set html_name Note} AdmissionScore {set html_name AdmissionScore} Info {set html_name Info} default {set html_name $category} } return $html_name } proc dbg {msg {category msg_level_critical} {location ""}} { global GradebookServerConfig if { $location ne "" } { set location " in $location" } switch $category { msg_level_info {set msg_header "Info$location:";} msg_level_warning {set msg_header "Warning$location:";} msg_level_dbg {set msg_header "Debug$location:";} msg_level_log {set msg_header "Log$location:";} msg_level_critical {set msg_header "Error$location:";} default {set msg_header "Unknown$location:";} } addLogEntry "dbg message level $msg_header" "$msg" "$category" } proc addLogEntry {entryTitle entryContent {category msg_level_critical}} { global GradebookServerConfig global logEntry switch $category { msg_level_info {set level 6} msg_level_warning {set level 4} msg_level_dbg {set level 3} msg_level_log {set level 2} msg_level_critical {set level 1} default {set level 0} } if { $level <= $GradebookServerConfig(verbosity_level) } { lappend logEntry "$entryTitle" [::json::write string "$entryContent"] } } proc logEntryToLogFile {} { global logEntry #::json::write indented false set logEntryJsonString [json::write object {*}$logEntry] rawTextToLogFile "$logEntryJsonString" } proc rawTextToLogFile {{msg "Error: message is not specified"}} { global GradebookServerConfig set fid [open $GradebookServerConfig(log_file) a+] puts $fid "$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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } 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 "$errStat2 for $sql_str" msg_level_critical [lindex [info level 0] 0] } } 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } return $value } proc GetDefaultGradesTableColumn {} { # this is the list of crucial GradesTable columns # column name and type set l [list \ FirstName text\ LastName text\ UserName [list text NOT NULL UNIQUE]\ 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 } if { ![doesColumnExists NumberToDrop GradesCategoryTable] } { dbg "Do not have column NumberToDrop in the table GradesCategoryTable may be you are using older version of database format" msg_level_info ModifyNumberOfLowestGradesToDropGradesCategory return } 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } 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 "$errStat for $sql_str" msg_level_critical [lindex [info level 0] 0] } 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" } { begin_db_transaction 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 ] end_db_transaction if { $err } { htmlErrorMsg $errStat dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } 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 EditGradesCategories dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } puts {} puts {} puts {} puts {
} puts {
} puts {
} #puts "Cancel changes" } proc isThereUserNameInTheGradesTable { username } { set eval_str [concat SELECT UserName FROM \'GradesTable\' WHERE UserName == \'$username\'] 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 false } if { 0 == [llength $username_list] } { return false } else { return true } } proc CheckAndCreateAsNeededInfoRow { row_name } { if { ![isThereUserNameInTheGradesTable $row_name] } { AddUserNonWeb {} {} $row_name inforow } } 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 "$errStat for $sql_str" msg_level_critical [lindex [info level 0] 0] } # add special users aka special info rows CheckAndCreateAsNeededInfoRow _Col_Category_ CheckAndCreateAsNeededInfoRow _Max_Points_ CheckAndCreateAsNeededInfoRow _Visible_To_Students_ CheckAndCreateAsNeededInfoRow _The_Highest_Grade_ CheckAndCreateAsNeededInfoRow _The_Lowest_Grade_ CheckAndCreateAsNeededInfoRow _The_Mean_Grade_ CheckAndCreateAsNeededInfoRow _The_Median_Grade_ CheckAndCreateAsNeededInfoRow _The_StDev_Grade_ # 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } } proc AddDefaultAccessRight { action instructor_right ta_right student_right dropped_student_right guest_right } { global defaultAccessRights if { ![info exist defaultAccessRights] } { set defaultAccessRights {} } # check if such action and its access table exists and remove it # so it will be replaced with a new one if { $action in $defaultAccessRights } { set indx [lsearch -all -exact $defaultAccessRights $action] foreach i $indx { set defaultAccessRights [lreplace $defaultAccessRights $i $i] # we do it one more time to remove the access table for removed action set defaultAccessRights [lreplace $defaultAccessRights $i $i] } } # finally we adding new action with it access table lappend defaultAccessRights $action [list instructor $instructor_right ta $ta_right student $student_right dropped $dropped_student_right guest $guest_right] } proc FillDefaultAccessRights {} { # guest should have no rights make sure that 0 is everywhere except logon # actionname instructor ta student dropped guest AddDefaultAccessRight logon 1 1 1 1 1 AddDefaultAccessRight showgrades 1 1 1 1 0 AddDefaultAccessRight sort 1 1 0 0 0 AddDefaultAccessRight addcolumnrequest 1 1 0 0 0 AddDefaultAccessRight addcolumn 1 1 0 0 0 AddDefaultAccessRight deletecolumn 1 1 0 0 0 AddDefaultAccessRight showcontrols 1 1 1 1 0 AddDefaultAccessRight changegrades 1 1 0 0 0 AddDefaultAccessRight updategrades 1 1 0 0 0 AddDefaultAccessRight edit_grades_categories 1 0 0 0 0 AddDefaultAccessRight update_grades_categories 1 0 0 0 0 AddDefaultAccessRight changecolumn 1 1 0 0 0 AddDefaultAccessRight updatecolumn 1 1 0 0 0 AddDefaultAccessRight logoff 1 1 1 1 0 AddDefaultAccessRight changefirstname 1 0 0 0 0 AddDefaultAccessRight changelastname 1 0 0 0 0 AddDefaultAccessRight changeusername 1 0 0 0 0 AddDefaultAccessRight userhidecolumn 1 1 1 1 0 AddDefaultAccessRight userunhidecolumn 1 1 1 1 0 AddDefaultAccessRight userhidegroup 1 0 0 0 0 AddDefaultAccessRight userunhidegroup 1 0 0 0 0 AddDefaultAccessRight userhidegradecategory 1 0 0 0 0 AddDefaultAccessRight userunhidegradecategory 1 0 0 0 0 AddDefaultAccessRight editcourseinfo 1 0 0 0 0 AddDefaultAccessRight updatecourseinfo 1 0 0 0 0 AddDefaultAccessRight editnewuserinfo 1 0 0 0 0 AddDefaultAccessRight addnewuserinfo 1 0 0 0 0 AddDefaultAccessRight choosenewpassword 1 1 1 1 0 AddDefaultAccessRight setnewpassword 1 1 1 1 0 AddDefaultAccessRight changegroupname 1 0 0 0 0 AddDefaultAccessRight setgroupname 1 0 0 0 0 AddDefaultAccessRight hidecolfromstudents 1 1 0 0 0 AddDefaultAccessRight unhidecolfromstudents 1 1 0 0 0 AddDefaultAccessRight resetforgottenpassword 0 0 0 0 1 AddDefaultAccessRight update_grades_stats 1 0 0 0 0 AddDefaultAccessRight edit_user_grade_request 1 1 0 0 0 AddDefaultAccessRight edit_user_grade 1 1 0 0 0 AddDefaultAccessRight edit_letter_grade_request 1 0 0 0 0 AddDefaultAccessRight edit_letter_grade 1 0 0 0 0 AddDefaultAccessRight show_grading_schema 1 1 1 1 0 } proc getDefaultPermissionsForGroup { group } { global defaultAccessRights if { ![info exist defaultAccessRights] } { FillDefaultAccessRights } set permission_list [list GroupName $group] foreach {action dummy} $defaultAccessRights { lappend permission_list $action [getDefaultPermission $action $group] } return $permission_list } proc FillMissingPermissionsWithDefaults { permission_list default_permission_list} { # permission_list takes precedense over default_permission_list set group [lindex $permission_list 1] set default_group [lindex $default_permission_list 1] if { $group ne $default_group } { dbg "attempt to join permission lists for different groups: $group and $default_group" msg_level_warning return $permission_list } foreach {action permission} $default_permission_list { if { $action ni $permission_list} { lappend permission_list $action $permission } } return $permission_list } proc getDefaultPermission { action group } { global defaultAccessRights if { ![info exist defaultAccessRights] } { FillDefaultAccessRights } if { $action ni $defaultAccessRights } { # unknown action is always forbidden return 0 } # find permissions for action set indx [lsearch -all -exact $defaultAccessRights $action] # increment index since permissions follows action element incr indx set permissions [lindex $defaultAccessRights $indx] if { $group ni $permissions } { # unknown groups have no rights return 0 } # find permission for the group set indx [lsearch -all -exact $permissions $group] # increment index since permission follows group element incr indx return [lindex $permissions $indx] } proc AddDefaultAccessRightToTableForActionNonWeb { action } { global defaultAccessRights if { ![info exist defaultAccessRights] } { FillDefaultAccessRights } set instructor_right [getDefaultPermission $action instructor] set ta_right [getDefaultPermission $action ta] set student_right [getDefaultPermission $action student] set dropped_student_right [getDefaultPermission $action dropped] set guest_right [getDefaultPermission $action guest] AddAccessRightNonWeb $action $instructor_right $ta_right $student_right $dropped_student_right $guest_right } 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 "$errStat" msg_level_critical [lindex [info level 0] 0] } FillDefaultAccessRights AddDefaultAccessRightToTableForActionNonWeb logon AddDefaultAccessRightToTableForActionNonWeb showgrades AddDefaultAccessRightToTableForActionNonWeb sort AddDefaultAccessRightToTableForActionNonWeb addcolumnrequest AddDefaultAccessRightToTableForActionNonWeb addcolumn AddDefaultAccessRightToTableForActionNonWeb deletecolumn AddDefaultAccessRightToTableForActionNonWeb showcontrols AddDefaultAccessRightToTableForActionNonWeb changegrades AddDefaultAccessRightToTableForActionNonWeb updategrades AddDefaultAccessRightToTableForActionNonWeb edit_grades_categories AddDefaultAccessRightToTableForActionNonWeb update_grades_categories AddDefaultAccessRightToTableForActionNonWeb changecolumn AddDefaultAccessRightToTableForActionNonWeb updatecolumn AddDefaultAccessRightToTableForActionNonWeb logoff AddDefaultAccessRightToTableForActionNonWeb changefirstname AddDefaultAccessRightToTableForActionNonWeb changelastname AddDefaultAccessRightToTableForActionNonWeb changeusername AddDefaultAccessRightToTableForActionNonWeb userhidecolumn AddDefaultAccessRightToTableForActionNonWeb userunhidecolumn AddDefaultAccessRightToTableForActionNonWeb userhidegroup AddDefaultAccessRightToTableForActionNonWeb userunhidegroup AddDefaultAccessRightToTableForActionNonWeb userhidegradecategory AddDefaultAccessRightToTableForActionNonWeb userunhidegradecategory AddDefaultAccessRightToTableForActionNonWeb editcourseinfo AddDefaultAccessRightToTableForActionNonWeb updatecourseinfo AddDefaultAccessRightToTableForActionNonWeb editnewuserinfo AddDefaultAccessRightToTableForActionNonWeb addnewuserinfo AddDefaultAccessRightToTableForActionNonWeb choosenewpassword AddDefaultAccessRightToTableForActionNonWeb setnewpassword AddDefaultAccessRightToTableForActionNonWeb changegroupname AddDefaultAccessRightToTableForActionNonWeb setgroupname AddDefaultAccessRightToTableForActionNonWeb hidecolfromstudents AddDefaultAccessRightToTableForActionNonWeb unhidecolfromstudents AddDefaultAccessRightToTableForActionNonWeb resetforgottenpassword AddDefaultAccessRightToTableForActionNonWeb update_grades_stats AddDefaultAccessRightToTableForActionNonWeb edit_user_grade_request AddDefaultAccessRightToTableForActionNonWeb edit_user_grade } proc htmlErrorMsg { msg {loc ""} } { if { $loc eq "" } { puts "
error: $msg
" } else { puts "
error in $loc: $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 htmlGradesTableHeadersRaw { permission_list user sql_column_str hidden_columns v_array_list sort_col} { global GradebookServerConfig global script_name array set permission $permission_list array set v $v_array_list # we need to prepend column list with UserCount column, so the counter appears first set v(*) [linsert $v(*) 0 UserCount] # the following us unnessesary since this proc use $v(*) to get column names # but I add the value just in case set v(UserCount) DummyValueForUserCount puts {} puts "" set first_column true foreach col $v(*) { if { $col in $hidden_columns } continue # detect what column category it is if { $col eq "UserCount" } { set category "user_counter_col" } else { set category [SelectColValue4User $col _Col_Category_] } global sticky_colums_list if { $col in $sticky_colums_list } { set category "$category $col sticky-col" } set sort_symbol "↓"; # down arrow set col_text "$col" if { $col eq "UserCount" } { set col_text "#"; # hash (#) symbol for } if { $col eq $sort_col } { set col_text "$col_text$sort_symbol" } puts -nonewline "$col_text" # below list has action and action_label pairs set action_list {userhidecolumn} switch $col { UserCount { set action_list {} } 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 "" puts "" } puts "" puts "" } proc getColAndValForUserName { user_name sql_column_str hidden_columns } { set eval_str [concat SELECT $sql_column_str FROM GradesTable WHERE UserName=\"$user_name\"] set err [catch { db eval $eval_str v { } } errStat ] if { $err } { dbg "we should never be here if UserName: $user_name exist in the table" msg_level_critical dbg $errStat msg_level_critical htmlErrorMsg $errStat return } else { return [array get v] } } proc htmlFormatMaxPossibleRaw { sql_column_str hidden_columns } { # show max point values in html format puts "" array set v [getColAndValForUserName _Max_Points_ $sql_column_str $hidden_columns] # we need to prepend column list with UserCount column, so the counter appears first set v(*) [linsert $v(*) 0 UserCount] global sticky_colums_list foreach c $v(*) { if { $c in $hidden_columns } continue switch $c { "UserCount" {set out_str ""} "FirstName" {set out_str "Max"} "LastName" {set out_str "Possible"} "GroupName" {set out_str ""} "UserName" {set out_str "_Derived_"} default { if { ![info exists v($c)] } { set out_str "N/A" } else { set out_str $v($c) } } } set category "" if { $c in $sticky_colums_list } { set category "$category $c sticky-col" } puts " $out_str " } puts "" } proc htmlFormatTheStatsForGradeRaw { stats_needed sql_column_str hidden_columns } { # show max or min point values in html format switch $stats_needed { "high" {set sql_user_name _The_Highest_Grade_} "low" {set sql_user_name _The_Lowest_Grade_} "mean" {set sql_user_name _The_Mean_Grade_} "median" {set sql_user_name _The_Median_Grade_} "stdev" {set sql_user_name _The_StDev_Grade_} "histogram_plot" {set sql_user_name _The_Grades_Hist_Text_Plot_} default { htmlErrorMsg "Required stats ($stats_needed) to output is not known" return "" } } array set v [getColAndValForUserName $sql_user_name $sql_column_str $hidden_columns] # we need to prepend column list with UserCount column, so the counter appears first set v(*) [linsert $v(*) 0 UserCount] set v(UserCount) "." set html_str "\n" foreach columnname $v(*) { if { ![info exists v($columnname)] } { # this raw does not exist abandone raw compillation return "" } if { $columnname in $hidden_columns } continue switch $columnname { "FirstName" {set col_value "Class"} "LastName" { switch $stats_needed { "high" {set col_value "High"} "low" {set col_value "Low"} "mean" {set col_value "Mean"} "median" {set col_value "Median"} "stdev" {set col_value "StDev"} "histogram_plot" {set col_value "Histogram"} default {set col_value "UNKNOWN"} } } "UserName" {set col_value "_Derived_"} default { if { ![info exists v($columnname)] } { set col_value "N/A" } else { set col_value $v($columnname) } } } set html_str [join [list $html_str "\n" [htmlFormatColVal $col_value $columnname $sql_user_name $sql_user_name {} {b}] ] {}] } set html_str [join [list $html_str "\n" ""]] return $html_str } proc getPhotoUrl { IdNum } { # generate url pointing to a photo of a user with the given IdNum global GradebookServerConfig set photo_album_base_url $GradebookServerConfig(photo_album_base_url) set photo_album_cache $GradebookServerConfig(photo_album_cache) set photo_album_cache_url $GradebookServerConfig(photo_album_cache_url) set photo_file "${IdNum}.jpg" set cached_photo_file "$photo_album_cache/${photo_file}" if { ${IdNum} eq "" } { # useless/invalid IdNum return "" } if { [file exist "$cached_photo_file"] } { # return link to locally cached file set url "$photo_album_cache_url/$photo_file" } else { # return link to the main WM photobase set url "$photo_album_base_url/${photo_file}" #cachePhoto $url } return $url } proc htmlFormatColVal { col_value columnname user user_shown permission_list {font_style {}} } { global script_name global GradebookServerConfig set col_value_raw $col_value set html_str {} set font_style_strt {} set font_style_end {} if { $font_style ne "" } { set font_style_strt "<$font_style>" set font_style_end "" } if { $columnname eq "UserCount" } { set category "user_counter_col" set max_points 0 } else { set category [SelectColValue4User $columnname _Col_Category_] set max_points [SelectColValue4User $columnname _Max_Points_] } global sticky_colums_list if { $columnname in $sticky_colums_list } { set category "$category $columnname sticky-col" } set special_user_names [list _Max_Points_ _The_Highest_Grade_ _The_Lowest_Grade_ _The_Mean_Grade_ _The_Median_Grade_ _The_StDev_Grade_ ] if { (([SelectColValue4User GroupName $user_shown] ne "inforow") || ($user in $special_user_names)) && ($category eq "weighted_column") && ($max_points != 0) } { if { $col_value eq "" } { set col_value 0 } # calculate letter grade to Grand Total if { ($columnname eq "Grand Total") && ($user ne "_The_StDev_Grade_") } { set col_value_letter_grade [number2letter_grade $col_value] } else { # leave intact for stdev set col_value_letter_grade $col_value } # promote to percent format set col_value [format "%04.2f%%" [expr {100.* $col_value} ] ] # add letter grade to Grand Total if { ($columnname eq "Grand Total") && ($user ne "_The_StDev_Grade_") } { set col_value [ concat $col_value "=" $col_value_letter_grade ] } } set col_str_value [htmlReplaceEmptyString $col_value] set col_str_value ${font_style_strt}${col_str_value}${font_style_end} # embedded actions on values assignment set embeded_actions_excluded_special_columns [ list \ PasswordHash GroupName UserHiddenColums \ UserCount \ FirstName \ LastName \ UserName \ IdNum \ SectionNum \ UserHiddenGroups \ UserHiddenGradeCategories \ ] set column_categories_without_marker [ list \ Note \ Info \ ] if { ([SelectColValue4User GroupName $user_shown] ne "inforow") && ($user ni $special_user_names) && ($columnname ni $embeded_actions_excluded_special_columns) && ($category ni $column_categories_without_marker) } { # adding histogram marker set hist_marker "" set col_histogram_limits [SelectColValue4User $columnname _The_Grades_Hist_Limits_] if { $col_histogram_limits ne "" } { set histPositionMarker [markNthBin [binInHistogram $col_value_raw $col_histogram_limits]] append hist_marker "$histPositionMarker
" } # adding special span for grade itself set col_str_value "$hist_marker$col_str_value" } if { ([SelectColValue4User GroupName $user_shown] ne "inforow") && ($user ni $special_user_names) && ($category ne "weighted_column") && ($columnname ni $embeded_actions_excluded_special_columns) } { if { [isActionGranted edit_user_grade $permission_list $user] && ($user_shown ne "_UNSET_") } { set col_str_value "${col_str_value}" } } # additional actions on values assignment switch $columnname { GroupName { set action_html_code {} switch $col_value { inforow { set action_html_code {} } default { if { [isActionGranted changegroupname $permission_list $user] && ($user_shown ne "_UNSET_") } { set separator {
} set action_html_code "$separatorChange" } } } set html_str [join [list ${html_str} "$col_str_value $action_html_code"] {}] } IdNum { set html_str [join [list ${html_str} ""] {} ] set IdNum $col_value set photo_url [ getPhotoUrl $IdNum ] if { $photo_url ne "" } { # 90x90 is WM default set photo_img_width $GradebookServerConfig(photo_img_width) set photo_img_height $GradebookServerConfig(photo_img_height) set html_str [join [list ${html_str} ""] {} ] } set html_str [join [list ${html_str} "$col_str_value"] {} ] } default { set html_str [join [list ${html_str} "$col_str_value"] {}] } } return $html_str } 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 } ## This section rearrange shown column set head_list {FirstName LastName UserName GroupName IdNum SectionNum} set tail_list {} # reduce column list set new_column_list {} foreach col $column_list { if {$col in $head_list} { continue } if {$col in $tail_list} { continue } lappend new_column_list $col } set column_list $new_column_list # put columns with Totals up front foreach col $column_list { #puts $col if { [regexp -nocase -- {total} $col] } { lappend head_list $col } else { lappend tail_list $col } } set column_list {} lappend column_list {*}$head_list lappend column_list {*}$tail_list set sql_column_str [colList2sqlColStr $column_list] # set users of what group user can see, i.e. set WHERE statement set where_statement {} switch $permission(GroupName) { instructor { # hide unwanted user groups set user_groups_for_hide [SelectColValue4User UserHiddenGroups $user] if {$user_groups_for_hide != {} } { foreach grp $user_groups_for_hide { if { $where_statement == {} } { set where_statement "WHERE GroupName<>\"$grp\"" } else { set where_statement [concat $where_statement "AND GroupName<>\"$grp\""] } } } } ta { set where_statement "WHERE GroupName=\"student\"" } student { set where_statement "WHERE UserName=\"$user\"" } 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]) && ([SelectColValue4User $sort_col _Col_Category_] ni [concat Note Info])} { 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 { set user_cnt 0 db eval $eval_str v { if { $show_header } { set show_header 0 puts {} set v_array_list [array get v] htmlGradesTableHeadersRaw $permission_list $user $sql_column_str $hidden_columns $v_array_list $sort_col puts {} htmlFormatMaxPossibleRaw $sql_column_str $hidden_columns puts [htmlFormatTheStatsForGradeRaw high $sql_column_str $hidden_columns] puts [htmlFormatTheStatsForGradeRaw mean $sql_column_str $hidden_columns] puts [htmlFormatTheStatsForGradeRaw stdev $sql_column_str $hidden_columns] puts [htmlFormatTheStatsForGradeRaw median $sql_column_str $hidden_columns] puts [htmlFormatTheStatsForGradeRaw low $sql_column_str $hidden_columns] puts [htmlFormatTheStatsForGradeRaw histogram_plot $sql_column_str $hidden_columns] } puts "" if { [info exist v(UserName)] } { set user_shown [htmlReplaceEmptyString $v(UserName)] } else { set user_shown "_UNSET_" } incr user_cnt set first_column true foreach columnname $v(*) { if { $columnname in $hidden_columns } continue if { $columnname != "*" } { # detect what column category it is set col_value $v($columnname) if { $first_column } { # we need to prepend first column with a user counter column set first_column false puts [htmlFormatColVal ${user_cnt} UserCount $user $user_shown $permission_list] } puts [htmlFormatColVal $col_value $columnname $user $user_shown $permission_list] } } puts "" } } errStat ] if { $err } { dbg "we should never be here if $sort_col exist in the table" msg_level_critical dbg $errStat msg_level_critical htmlErrorMsg $errStat } puts "" puts "
" } 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 { # we do not need to run SetSortColumn since it is done at the very beginning # before we run ::ncgi::header 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 } show_grading_schema { htmlShowGradingSchema $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 } update_grades_stats { UpdateGradesTableStatistic $permission_list $user htmlDefaultView $permission_list $user } edit_letter_grade_request { htmlEditLetterGradeRequest $permission_list $user } edit_letter_grade { EditLetterGrade $permission_list $user htmlDefaultView $permission_list $user } edit_user_grade_request { htmlEditUserGradeValue $permission_list $user } edit_user_grade { EditUserGradeValue $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 EditUserGradeValue {permission_list user } { global script_name set subaction [::ncgi::value subaction {}] set modified_user [::ncgi::value user2modify {}] set modified_column [::ncgi::value column2modify {}] set new_value [::ncgi::value newcolumnvalue {}] if { $subaction eq "Cancel" } { return } if { $subaction eq "Submit" } { UpdateColValue4UserNameNonWeb $modified_column $modified_user $new_value calculteWeightedTotals set update_parent true UpdateColumnStatistic $modified_column $update_parent } } proc htmlEditUserGradeValue {permission_list user } { global script_name set modified_user [::ncgi::value user2modify {}] set modified_column [::ncgi::value column2modify {}] set current_group_name [SelectColValue4User GroupName $modified_user] set FirstName [SelectColValue4User FirstName $modified_user] set LastName [SelectColValue4User LastName $modified_user] set old_value [SelectColValue4User $modified_column $modified_user] set column_category [SelectColValue4User $modified_column _Col_Category_] puts "
" puts "Change grade for student $FirstName $LastName with user name $modified_user" puts "
" set needs_textarea false switch $column_category { Note {set needs_textarea true} Info {set needs_textarea true} default { } } if { !$needs_textarea } { puts "$modified_column old value: \{$old_value\}," puts "new value:
" } else { puts "$modified_column:" puts "

" } puts {} puts [join [ list {} ] ""] puts [join [ list {} ] "" ] puts {} puts {} puts {
} puts "
" } 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 UpdateGradesTableStatistic $permission_list $user } } 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 "$errStat for $sql_str" msg_level_critical [lindex [info level 0] 0] } } 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 "$errStat2 for $sql_str" msg_level_critical [lindex [info level 0] 0] } } 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 "$errStat2 for $sql_str" msg_level_critical [lindex [info level 0] 0] } } proc LeaveOnlyNumbersInList { l } { set new_list {} foreach {el} $l { if { [string is double -strict $el] } { lappend new_list $el } } return $new_list } proc GetGroupValuesInColumn { group_name columnname } { set col_values {} set eval_str "SELECT \"$columnname\" FROM GradesTable WHERE GroupName=\"$group_name\"" set err [catch { db eval $eval_str v { if { [info exist v($columnname)] } { lappend col_values $v($columnname) } } } errStat ] if { $err } { htmlErrorMsg $errStat dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } return $col_values } proc UpdateAndCreateAsNeededInfoRow { columnname inforow val } { CheckAndCreateAsNeededInfoRow $inforow UpdateColValue4UserNameNonWeb $columnname $inforow $val } proc UpdateColumnGradesHistogram { columnname } { # find maximum in the column with a given name among active students set hist "N/A" set limits "N/A" set textHist "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set minVal 0 set maxVal [getMaxPointsForColumn $columnname ] if { $minVal >= $maxVal } { # most likely column has maximum points undefined or zero # like for bonuses or fudge columns set maxVal [::math::statistics::max $col_values ]; # fixme should it be _Max_Points_? } if { $minVal >= $maxVal } { set errorMessage "something really messed up with column $columnname min and max points, applying kludge recovery." htmlErrorMsg $errorMessage dbg $errorMessage msg_level_critical [lindex [info level 0] 0] # kludge/hack to make ::math::statistics::minmax-histogram-limits happy set maxVal [expr {$minVal+1}] } set barsNum 10; set uniqNum [llength [lsort -unique $col_values]] set barsNum [expr {min($uniqNum, $barsNum)}]; # heuristic about number of bars/intervals set barsNum [expr {max(2, $barsNum)}]; # at least 2 bars since we strip left and right set limits [::math::statistics::minmax-histogram-limits $minVal $maxVal [incr barsNum]] set limits [lrange $limits 1 end-1]; # shave first and last interval limits set hist [::math::statistics::histogram $limits $col_values ] set textHist [data2txtPlot $hist] } UpdateAndCreateAsNeededInfoRow $columnname _The_Grades_Histogram_ $hist UpdateAndCreateAsNeededInfoRow $columnname _The_Grades_Hist_Limits_ $limits UpdateAndCreateAsNeededInfoRow $columnname _The_Grades_Hist_Text_Plot_ $textHist } proc UpdateColumnHighestGrade { columnname } { # find maximum in the column with a given name among active students set val "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set val [expr max([join $col_values ,])] } CheckAndCreateAsNeededInfoRow _The_Highest_Grade_ set column_category [SelectColValue4User $columnname _Col_Category_] UpdateColValue4UserNameNonWeb $columnname _The_Highest_Grade_ $val } proc UpdateColumnLowestGrade { columnname } { # find minimum in the column with a given name among active students set val "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set val [expr min([join $col_values ,])] } CheckAndCreateAsNeededInfoRow _The_Lowest_Grade_ set column_category [SelectColValue4User $columnname _Col_Category_] UpdateColValue4UserNameNonWeb $columnname _The_Lowest_Grade_ $val } proc UpdateColumnMeanGrade { columnname } { # find minimum in the column with a given name among active students set val "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set val [::math::statistics::mean $col_values ] # rounding value to 2 digits set val [format "%04.2f" $val ] } CheckAndCreateAsNeededInfoRow _The_Mean_Grade_ set column_category [SelectColValue4User $columnname _Col_Category_] UpdateColValue4UserNameNonWeb $columnname _The_Mean_Grade_ $val } proc UpdateColumnMedianGrade { columnname } { # find minimum in the column with a given name among active students set val "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set val [::math::statistics::median $col_values ] # rounding value to 2 digits set val [format "%04.2f" $val ] } CheckAndCreateAsNeededInfoRow _The_Median_Grade_ set column_category [SelectColValue4User $columnname _Col_Category_] UpdateColValue4UserNameNonWeb $columnname _The_Median_Grade_ $val } proc UpdateColumnStDevGrade { columnname } { # find minimum in the column with a given name among active students set val "N/A" set col_values [GetGroupValuesInColumn student $columnname] set col_values [LeaveOnlyNumbersInList $col_values] if { 0 != [llength $col_values] } { set val [::math::statistics::stdev $col_values ] if { $val ne "" } { # rounding value to 2 digits set val [format "%04.2f" $val ] } else { set val "N/A" } } CheckAndCreateAsNeededInfoRow _The_StDev_Grade_ set column_category [SelectColValue4User $columnname _Col_Category_] UpdateColValue4UserNameNonWeb $columnname _The_StDev_Grade_ $val } proc UpdateGradesTableStatistic { permission_list user } { set grades_categories [get_grades_category] # remove unset and deleted categories from stats calculation set grades_categories [lsearch -all -inline -not -exact $grades_categories unset] set grades_categories [lsearch -all -inline -not -exact $grades_categories deleted] set all_column_names [getColListFromTable GradesTable] set columns_to_update {} # select columns only with grades foreach columnname $all_column_names { set column_category [SelectColValue4User $columnname _Col_Category_] if { $column_category in $grades_categories } { lappend columns_to_update $columnname } } # add column with totals for each grades category foreach category $grades_categories { lappend columns_to_update ${category}Total } lappend columns_to_update "Grand Total" # update all of this columns begin_db_transaction foreach columnname $columns_to_update { set update_parent_flag false UpdateColumnStatistic $columnname $update_parent_flag } end_db_transaction } proc UpdateColumnStatistic { columnname {update_parent_flag true} } { set all_column_names [getColListFromTable GradesTable] if { $columnname ni $all_column_names } { return } begin_db_transaction # FIXME all updates pull the same data. Cache it and reuse UpdateColumnHighestGrade $columnname UpdateColumnLowestGrade $columnname UpdateColumnMeanGrade $columnname UpdateColumnMedianGrade $columnname UpdateColumnStDevGrade $columnname UpdateColumnGradesHistogram $columnname end_db_transaction # check recursion exit conditions if { !$update_parent_flag } return if { $columnname eq "Grand Total" } return set column_category [SelectColValue4User $columnname _Col_Category_] # FIXME this miss propagation of update of non weighted column which does not require category total! for example it is typical for participation if { $column_category ne "weighted_column" } { set root_category_column ${column_category}Total } else { set root_category_column "Grand Total" } UpdateColumnStatistic $root_category_column } 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" } { begin_db_transaction 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 ] end_db_transaction if { $err } { htmlErrorMsg $errStat dbg "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } else { calculteWeightedTotals set update_parent true UpdateColumnStatistic $columnname $update_parent } } } 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } 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 "$errStat for $eval_str" msg_level_critical [lindex [info level 0] 0] } 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"\ edit_letter_grade_request "Letter grade settings"\ editnewuserinfo "Add new user"\ choosenewpassword "Choose new password"\ edit_grades_categories "Edit Grades Categories and Weights"\ update_grades_stats "Update Statistics"\ 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 "
" puts "
" # buttons to call javascript styles puts {\
} 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 AddMissingDefaultRights { permission_list group } { } 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 addLogEntry userGroup "$group" msg_level_log 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 set default_permission_list [getDefaultPermissionsForGroup $group] set permission_list [FillMissingPermissionsWithDefaults $permission_list $default_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 htmlShowGradingSchema { permission_list user } { global GradebookServerConfig set grading_scheme [get_grading_scheme] set prevThreshold "" set skipAplus $GradebookServerConfig(skipAplus) set separator "; " puts {
} puts {

} puts {Final letter grade is assigned by the following scheme:} puts {

} puts {

} set scheme_strings {} # we assume that grading_scheme sorted in order from A+ to F foreach {letter threshold} $grading_scheme { if { $skipAplus} { if { $letter eq "A+" } { continue } } # converting to percents set threshold [expr {round(100.0*$threshold)}] set threshold "$threshold%" if { $prevThreshold eq "" } { lappend scheme_strings "$letter: >= $threshold" } else { if { $letter eq "F" } { lappend scheme_strings "$letter: < $prevThreshold" } else { lappend scheme_strings "$letter: \[$threshold, $prevThreshold)" } } set prevThreshold $threshold } puts [join [lreverse $scheme_strings] $separator] puts {

} puts {
} } proc htmlDefaultView { permission_list user } { ChoseAction showcontrols $permission_list $user ChoseAction show_grading_schema $permission_list $user ChoseAction showgrades $permission_list $user } proc htmlHeader {} { set CourseTitle [SelectItemFromCourseInfoTable course_title] set CourseYear [SelectItemFromCourseInfoTable course_year] set CourseSemester [SelectItemFromCourseInfoTable course_semester] set page_title "Course grades for $CourseTitle, $CourseYear - $CourseSemester" puts { } puts [join [list { } {} $page_title {}] ""] puts {\ } } proc htmlHeaderDBSelector {} { puts { Grade Books Selector } } ##################### end of procs #################################### # vim: ts=2 sw=2 foldmethod=indent: