path: root/GradeBook_lib.tcl

#!/bin/sh
# (C) 2010 by Eugeniy Mikhailov, <evgmik@gmail.com>
# vim:set ft=tcl: \
exec tclsh "$0" "$@"

# require Tcl version of at least 8.5 since I use 'ni' and 'in' in expressions for lists
package require Tcl 8.5

source ./libBasicTableOperations.tcl

# internal version of this code
set VERSION 2.0.0

# ########################################################################
# this should be in config file but these are reasonable defaults
array set GradebookServerConfig [list \
	icon_dir "/~evmik/icons" \
	use_icons true \
	grades_db_dir "./courses" \
	passwords_db_file "./passwd.db" \
	html_access_stats_url "/~evmik/grade_book_stats/" \
	verbosity_level 100 \
	]
# ########################################################################

# ########################## 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 [glob -tails -d ${grades_db_dir}/ *]
	return $db_files_list
}

proc get_grading_scheme {} {
	# pair of letter grade and lower boundary for this grade
	# should be sorted in descended order!
	set grading_scheme [ list  \
		A	 0.94 \
		A- 0.90 \
		B+ 0.87 \
		B  0.84 \
		B- 0.80 \
		C+ 0.77 \
		C  0.74 \
		C- 0.70 \
		D+ 0.67 \
		D  0.64 \
		D- 0.60 \
		F  0.00 \
	]
	return  $grading_scheme
}

# Grades category and their html names
proc get_grades_category {} {
	set eval_str "SELECT CategoryName  FROM GradesCategoryTable"
	set grades_category {} 
	set err [catch {
		db eval $eval_str v {
			lappend grades_category  $v(CategoryName) 
		}
	} errStat ]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
	#set grades_category [list \
		#"unset"\
		#Quiz\
		#HomeWork\
		#LabReport\
		#MidTerm\
		#FinalExam\
	#]
	return $grades_category
}


proc default_grades_category {} {
	set grades_category [list \
			"unset"\
			Quiz\
			HomeWork\
			LabReport\
			Participation\
			MidTerm\
			FinalExam\
		]
	return $grades_category
}
	
proc getGradingWeights { } {
	set category_name_weight_list {}
	set eval_str [concat SELECT CategoryName,CategoryWeight FROM GradesCategoryTable]
	set err [catch {
		db eval $eval_str v {
			set category $v(CategoryName)
			set weight $v(CategoryWeight)
			if { ![string is double -strict $weight] } { 
				htmlInfoMsg "weight for category: $category is not a number, setting it to 0"
				set weight 0 
				ModifyWeightForGradesCategory db $category 0
			}
			lappend category_name_weight_list $category $weight
			}
		} errStat ]
		if { $err } {
			dbg "we should never be here if GradesCategoryTable exists" msg_level_critical
			dbg $errStat msg_level_critical
			htmlErrorMsg $errStat
		}
	return $category_name_weight_list	
}

proc isCalculateTotalForCategorySet { category } {
	if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName  $category ]} {
		dbg  "Category: $category does not exists in the GradesCategoryTable, setting CalculateTotal to false" msg_level_info
		return false
	}
	set flag [SelectColvalueFromTable GradesCategoryTable NeedsTotal CategoryName $category]
	if { $flag } {
		return true 
	} else {
		return false
	}
}

proc 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 calculteSumOfPointsForStudentInCategory { student category } {
	set all_col_in($category) [ findColumnNamesInCategory $category ]
	set gained_points 0
	set excused_points 0 ; # some assignment can be incomplete for a reasonable excuse (i.e. medical)
	foreach col $all_col_in($category) {
		set col_val [SelectColValue4User $col $student]
		if { $col_val eq "" } {
			set col_val 0
		}
		# special cases for grades which are not a number: excuses or other notes
		if { ![string is double -strict $col_val] } {
			if { [regexp -nocase -- {excuse} $col_val] } {
				# this grade will not be counted and maximum points for this student adjusted accordingly
				set col_val 0
				set excused_points [expr { $excused_points + [getMaxPointsForColumn $col]}]
			} else {
				htmlInfoMsg "the user $student has a grade $col_val  in column $col,  which is not a number. Using 0 instead"
				set col_val 0
			}
		}
		set gained_points [expr { $gained_points + $col_val}]
	}
	set PointsSum(gained_points)  $gained_points
	set PointsSum(excused_points) $excused_points
	return [array get PointsSum]
}

proc calculteWeightedTotals { } {
	set grades_category [ get_grades_category ]
	#global grades_category
	set all_column_names [getColListFromTable GradesTable]
	
	set students_list [ allUserNamesInGroup student ]
	set students_list [concat $students_list [ allUserNamesInGroup dropped ] ]

	# locate all column names of this category
	foreach category $grades_category {
		set flag_delete_CategoryWeightedTolal false
		set CategoryWeightedTolalName  ${category}Total
		if { [isCalculateTotalForCategorySet $category] } {
			set all_col_in($category) [ findColumnNamesInCategory $category ]

			set tmpList [ calculteMaxPointsInCategory $category ]
			set max_points($category) [lindex $tmpList 0]
			set num_of_cols($category) [lindex $tmpList 1]

			if { $num_of_cols($category) >= 2 } {
				# no weighted total column created for categories which do no have at least 2 columns
				# check if Weighted Category Column exists
				if { $CategoryWeightedTolalName ni $all_column_names } {
					dbg "Column $CategoryWeightedTolalName does not exist, will create it now" msg_level_info
					AddColumnNonWeb $CategoryWeightedTolalName weighted_column 0 
				}
			} else {
				set flag_delete_CategoryWeightedTolal true 
			}
			if { [doesColumnExists $CategoryWeightedTolalName GradesTable] } {
				UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName _Max_Points_   $max_points($category)

				# calculated weighted sum for each student in this category
				foreach student $students_list {
					array set PointsSum [ calculteSumOfPointsForStudentInCategory $student $category ]
					set points_sum($category,$student) $PointsSum(gained_points)
					set excused_points($category,$student) $PointsSum(excused_points)
					set max_points($category,$student) [expr { $max_points($category) - $excused_points($category,$student)}]
					if { $max_points($category,$student) != 0 } {
						# normalizing
						set points_sum($category,$student) [expr { 1. * $points_sum($category,$student) / $max_points($category,$student) } ]
					}
					UpdateColValue4UserNameNonWeb $CategoryWeightedTolalName $student   $points_sum($category,$student)
				}
			}
		} else {
			set flag_delete_CategoryWeightedTolal true 
		}
		if { $flag_delete_CategoryWeightedTolal && ([doesColumnExists $CategoryWeightedTolalName GradesTable]) } {
			DeleteColumnFromTable GradesTable $CategoryWeightedTolalName
		}
	}

	# now calculation of weighted grand total
	set grand_total_col_name "Grand Total"
	if { $grand_total_col_name ni $all_column_names } {
		dbg "Column $grand_total_col_name does not exist, will create it now" msg_level_info
		AddColumnNonWeb $grand_total_col_name weighted_column 0 
	}
	foreach student $students_list {
		set grand_total($student) 0
		foreach {category weight} [getGradingWeights] {
			if { ![info exist max_points($category)] } {
				set tmpList [ calculteMaxPointsInCategory $category ]
				set max_points($category) [lindex $tmpList 0]
			}
			if { ![info exist points_sum($category,$student)] } {
				array set PointsSum [ calculteSumOfPointsForStudentInCategory $student $category ]
				set points_sum($category,$student) $PointsSum(gained_points)
				set excused_points($category,$student) $PointsSum(excused_points)
				set max_points($category,$student) [expr { $max_points($category) - $excused_points($category,$student)}]
				if { $max_points($category,$student) != 0 } {
					# normalizing
					set points_sum($category,$student) [expr { 1. * $points_sum($category,$student) / $max_points($category,$student) } ]
				}
			}
			if { $max_points($category,$student) == 0} {
				dbg "Category: $category has 0 for total maximum points. Skipping it." 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
}

proc grade_Category2html_name { category } {
	switch $category {
		"unset"      {set html_name --Select--}
		Quiz         {set html_name Quiz}
		HomeWork     {set html_name HomeWork}
		LabReport    {set html_name LabReport}
		Participation {set html_name Participation}
		MidTerm      {set html_name MidTerm}
		FinalExam    {set html_name FinalExam}
		default      {set html_name unknown}
	}
	return $html_name
}

proc dbg {msg {category msg_level_critical}} {
	switch $category {
		msg_level_info       {set msg_header "Info:";       set level 6}
		msg_level_warning    {set msg_header "Warning:";    set level 4}
		msg_level_dbg        {set msg_header "Debug:";      set level 3}
		msg_level_log        {set msg_header "Log:";        set level 2}
		msg_level_critical   {set msg_header "Error:";      set level 1}
		default              {set msg_header "Unknown:";    set level 0}
	}

	if { $level <=4 } {
		set fid [open log a+]
		puts $fid "$msg_header $msg"
		close $fid
	}
}

proc timestamp { } {
	return [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"]
}

proc ColName2SqlSafeForm {colname} {
	set bad_symbols [list {\}} {\{} {\\} {\'} {\"} {\]} {\[} ]
	foreach bs $bad_symbols {
		regsub -all $bs $colname "" colname 
	}
	return $colname
}

proc AddUserNonWeb { first_name last_name user_name {group_name {guest}} {id_number {}} {section_num {} } } {
	set eval_str [concat INSERT INTO GradesTable (FirstName, LastName, UserName, GroupName, IdNum, SectionNum) VALUES('$first_name', '$last_name', '$user_name', '$group_name', '$id_number', '$section_num')]
	set err [catch {db eval $eval_str  } errStat]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
}

proc AddCourseInfoTableItem {  item value } {
	set eval_str [concat INSERT INTO  CourseInfoTable (Item, Value) VALUES('$item', '$value') ]
	set err [catch {db eval $eval_str  } errStat]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
}

proc UpdateCourseInfoTableItem {  item value } {
					set sql_str [concat UPDATE CourseInfoTable  SET \"Value\"=\'$value\' where Item=\"$item\"]
					set err2 [catch {
						db eval $sql_str
					} errStat2 ]
					if { $err2 } {
						htmlErrorMsg  $errStat2 
						dbg  "the following error happen: $errStat2" msg_level_critical
					} 
}

proc CreateCourseInfoTable {db} {
	set err [catch {db eval {CREATE TABLE CourseInfoTable(Item text, Value text)} } errStat] 
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
	AddCourseInfoTableItem course_title     "Unset"
	AddCourseInfoTableItem course_year      "Unset"
	AddCourseInfoTableItem course_semester  "Unset"
}

proc SelectItemFromCourseInfoTable { item } {
	set value {}
	set eval_str "SELECT \"Value\"  FROM CourseInfoTable  where Item=\"$item\""
	set err [catch {
		db eval $eval_str v {
			set value $v(Value)
		}
	} errStat ]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
	return $value
}

proc GetDefaultGradesTableColumn {} {
	# this is the list of crucial  GradesTable columns
	# column name and type
	set l [list \
		FirstName text\
		LastName text\
		UserName text\
		GroupName text\
		UserHiddenColums text\
		UserHiddenGroups text\
		UserHiddenGradeCategories text\
		IdNum text\
		SectionNum text\
		]
	return $l
}

proc ModifyNeedsTotalForGradesCategory {db category flag} {
	if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName  $category ]} {
		dbg  "Category: $category does not exists in the GradesCategoryTable, creating it" msg_level_info
		AddGradesCategory db $category
	}
	UpdateColumnWithValueInTableWhere GradesCategoryTable  NeedsTotal $flag CategoryName $category 
}

proc ModifyWeightForGradesCategory {db category weight} {
	if {![existsColumnWithRowvalueInTable GradesCategoryTable CategoryName  $category ]} {
		dbg  "Category: $category already does not exists in the GradesCategoryTable, creating it" msg_level_info
		AddGradesCategory db $category
	}
	UpdateColumnWithValueInTableWhere GradesCategoryTable  CategoryWeight $weight CategoryName $category
}
\

proc AddGradesCategory {db category} {
	if {[existsColumnWithRowvalueInTable GradesCategoryTable CategoryName  $category ]} {
		dbg  "Category: $category already exists in the GradesCategoryTable" msg_level_info
		return
	}
	set eval_str [concat INSERT INTO GradesCategoryTable (CategoryName) VALUES('$category')]
	set err [catch {db eval $eval_str  } errStat]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
	ModifyWeightForGradesCategory db $category 0
	ModifyNeedsTotalForGradesCategory db $category false
}

proc CreateGradesCategoryTable {db} {
	# construct sql string for table creation
	set sql_str {CREATE TABLE GradesCategoryTable(CategoryName text, CategoryWeight float, NeedsTotal text)}
	set err [catch {db eval $sql_str } errStat] 

	if { $err && ($errStat ne "table GradesCategoryTable already exists") } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 

	foreach category [default_grades_category] {
		AddGradesCategory db $category 
	}
}

proc UpdateGradesCategores { db permission_list user } {
	global script_name
	set subaction [::ncgi::value subaction {}]
	set nv [::ncgi::nvlist]
	array set colval  $nv
	if { $subaction eq "Cancel" } {
		return
	}
	if { $subaction eq "Submit" } {
		set eval_str "SELECT CategoryName  FROM GradesCategoryTable"
		set err [catch {
				db eval $eval_str v {
					if { [info exist colval($v(CategoryName)_weight)] } {	
						ModifyWeightForGradesCategory db $v(CategoryName) $colval($v(CategoryName)_weight)
					}
					if { [info exist colval($v(CategoryName)_needs_total)] } {	
						# check box existance means it set to true
						ModifyNeedsTotalForGradesCategory db $v(CategoryName) true
					} else {
						ModifyNeedsTotalForGradesCategory db $v(CategoryName) false
					}
				}
			} errStat ]
		if { $err } {
			htmlErrorMsg  $errStat 
			dbg  "the following error happen: $errStat" msg_level_critical
		} 
	}

	calculteWeightedTotals
}

proc EditGradesCategories { db permission_list user } {
	global script_name
	lappend column_list CategoryName CategoryWeight NeedsTotal
	set sql_column_list [join $column_list ","]
	puts {<div class="change_categories">}
	puts {<div class="categories_table">}
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	# 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  {<table class="categories_table" border="1">}
				puts  "<tr>"
				foreach col  $v(*) {
					puts -nonewline "<th>$col</th>"
					}
					puts  "<tr>"
				} else {
					puts  "<tr>"
				}
				foreach index $v(*) {
					if { $index != "*" } {
						switch $index {
							"CategoryWeight" {
								puts "<th><input type=\"text\" name=\"$v(CategoryName)_weight\" value=\"$v(CategoryWeight)\" size=5></th>"
							}
							"NeedsTotal" {
								if { $v(NeedsTotal) eq "true" } {
									set checkbox_flag "checked"
								} else {
									set checkbox_flag ""
								}
									puts "<th><input type=\"checkbox\" name=\"$v(CategoryName)_needs_total\" value=\"\" $checkbox_flag></th>"
							}
							default {
								puts -nonewline "<td>$v($index)</td>"
							}
						}
					}
				}
				puts "</tr>"
			}
		} errStat ]
		puts  "</table>"
		if { $err } {
			htmlErrorMsg  $errStat 
			dbg  "the following error happen: $errStat" msg_level_critical
	} 
	puts {<input type="hidden" name="action" value="update_grades_categories"/>}
	puts {<input type="submit" name="subaction" value="Submit" />}
	puts {<input type="submit" name="subaction" value="Cancel" />}
	puts {</form>}
	puts {</div>}
	puts {</div>}
	#puts "<a href=\"$script_name\">Cancel changes</a>"

}


proc CreateGradesTable {db} {
	# construct sql string for table creation
	set sql_str {CREATE TABLE GradesTable(}
	set flag_firsttime true
	foreach {col coltype} [GetDefaultGradesTableColumn] {
		if { $flag_firsttime} {
			set flag_firsttime false
			set sql_str [concat $sql_str $col $coltype]
		} else {
			set sql_str [concat  $sql_str , $col $coltype]
		}
	}
	set sql_str [concat $sql_str )]
	puts $sql_str

	set err [catch {db eval $sql_str } errStat] 
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 

	# add special users aka special info rows
	AddUserNonWeb  {} {}  _Col_Category_  inforow
	AddUserNonWeb  {} {}  _Max_Points_    inforow
	AddUserNonWeb  {} {}  _Visible_To_Students_   inforow

	# reasonable defaults for hidden columns
	#set instructor_hidden_columns [list UserHiddenColums UserHiddenGroups IdNum]
	#UpdateColValue4GroupNameNonWeb UserHiddenColums instructor $instructor_hidden_columns
}

proc AddAccessRightNonWeb { action instructor_right ta_right student_right dropped_student_right guest_right } {
	set eval_str [concat INSERT INTO AccessRightsTable (actionname, instructor, ta, student, dropped, guest) VALUES('$action', '$instructor_right', '$ta_right', '$student_right', '$dropped_student_right', '$guest_right')]
	set err [catch {db eval $eval_str  } errStat]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
}

proc CreateAccessRightsTable {db} {
	set err [catch {db eval {CREATE TABLE AccessRightsTable(actionname text,               instructor integer, ta integer, student integer, dropped integer,  guest integer)} } errStat]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_critical
	} 
	# guest should have no rights make sure that 0 is evereywhere except logon
	#                    actionname                instructor   ta   student dropped   guest
	AddAccessRightNonWeb logon                     1            1    1       1         1
	AddAccessRightNonWeb showgrades                1            1    1       1         0
	AddAccessRightNonWeb sort                      1            1    0       0         0
	AddAccessRightNonWeb addcolumnrequest          1            1    0       0         0
	AddAccessRightNonWeb addcolumn                 1            1    0       0         0
	AddAccessRightNonWeb deletecolumn              1            1    0       0         0
	AddAccessRightNonWeb showcontrols              1            1    1       1         0
	AddAccessRightNonWeb changegrades              1            1    0       0         0
	AddAccessRightNonWeb updategrades              1            1    0       0         0
	AddAccessRightNonWeb edit_grades_categories    1            0    0       0         0
	AddAccessRightNonWeb update_grades_categories  1            0    0       0         0
	AddAccessRightNonWeb changecolumn              1            1    0       0         0
	AddAccessRightNonWeb updatecolumn              1            1    0       0         0
	AddAccessRightNonWeb logoff                    1            1    1       1         0
	AddAccessRightNonWeb changefirstname           1            0    0       0         0
	AddAccessRightNonWeb changelastname            1            0    0       0         0
	AddAccessRightNonWeb changeusername            1            0    0       0         0
	AddAccessRightNonWeb userhidecolumn            1            1    1       1         0
	AddAccessRightNonWeb userunhidecolumn          1            1    1       1         0
	AddAccessRightNonWeb userhidegroup             1            0    0       0         0
	AddAccessRightNonWeb userunhidegroup           1            0    0       0         0
	AddAccessRightNonWeb userhidegradecategory     1            0    0       0         0
	AddAccessRightNonWeb userunhidegradecategory   1            0    0       0         0
	AddAccessRightNonWeb editcourseinfo            1            0    0       0         0
	AddAccessRightNonWeb updatecourseinfo          1            0    0       0         0
	AddAccessRightNonWeb editnewuserinfo           1            0    0       0         0
	AddAccessRightNonWeb addnewuserinfo            1            0    0       0         0
	AddAccessRightNonWeb choosenewpassword         1            1    1       1         0
	AddAccessRightNonWeb setnewpassword            1            1    1       1         0
	AddAccessRightNonWeb changegroupname           1            0    0       0         0
	AddAccessRightNonWeb setgroupname              1            0    0       0         0
	AddAccessRightNonWeb hidecolfromstudents       1            1    0       0         0
	AddAccessRightNonWeb unhidecolfromstudents     1            1    0       0         0
	AddAccessRightNonWeb resetforgottenpassword    0            0    0       0         1
}

proc htmlErrorMsg { msg } {
			puts "<div class=\"errormsg\">error: $msg</div>"
}

proc htmlInfoMsg { msg } {
	puts {<div class=infomsg>}
	puts "$msg"
	puts {</div>}
}

proc htmlReplaceEmptyString { string } {
	#  empty string replaced with "---"
	regsub {^$} $string "---" string 
	# white spaces only string replaced with "---"
	regsub {^\s+$} $string "---" string 
	set string
}

proc action2atributes { action_name } {
	# return list of action_name, text description, and icon name
	# for each action
	global GradebookServerConfig
	set icon_dir $GradebookServerConfig(icon_dir)
	case $action_name {
		userhidecolumn        { set attrib [list $action_name "hide"   $icon_dir/hide.png ]}
		changefirstname       { set attrib [list $action_name "change first name" $icon_dir/edit.png ]}
		changelastname        { set attrib [list $action_name "change last name"         $icon_dir/edit.png ]}
		changeusername        { set attrib [list $action_name "change user name"         $icon_dir/edit.png ]}
		hidecolfromstudents   { set attrib [list $action_name "hide from students"  $icon_dir/students_unhide.png ]}
		unhidecolfromstudents { set attrib [list $action_name "show to students"  $icon_dir/students_hide.png ]}
		changegrades          { set attrib [list $action_name "change grades"              $icon_dir/edit.png ]}
		deletecolumn          { set attrib [list $action_name "delete"                     $icon_dir/delete_column.png ]}
		changecolumn          { set attrib [list $action_name "change column"              $icon_dir/tune.png ]}
		default               { set attrib [list $action_name "unknown" $icon_dir/tbd.png ]}
	}
	return $attrib
}

proc number2letter_grade { num } {
	# grading_scheme MUST be sorted in descending order!
	# here we do proper percent rounding
	set num [expr {round(100.0*$num)/100.0}]
	set grading_scheme [get_grading_scheme]
	foreach {letter threshold} $grading_scheme {
		if { $num >= $threshold } {
			return $letter
		}
	}
	# should never reach this point if grading scheme set properly
	return "NA"
}

proc htmlDBout {db permission_list user {sort_col {}}} {
	array set permission $permission_list
	global GradebookServerConfig
	global script_name
	#global grades_category
	set grades_category [ get_grades_category ]
	set defSortCol LastName 

	# testing for the existence of the sorting column
	if { ![doesColumnExists $sort_col GradesTable] } {
		dbg "changing to default sorting column $defSortCol" msg_level_info
		set sort_col $defSortCol
	}

	puts  {<div class="gradestable">}
	set show_header 1
	# get names of all columns
	set column_list [getColListFromTable GradesTable]
	# set hidden column list
	switch $permission(GroupName) {
		instructor { set hidden_columns {} }
		ta         { set hidden_columns [list UserName GroupName UserHiddenColums UserHiddenGroups UserHiddenGradeCategories IdNum] }
		student    { set hidden_columns [list UserName GroupName UserHiddenColums UserHiddenGroups  UserHiddenGradeCategories IdNum SectionNum] }
		dropped    { set hidden_columns [list UserName GroupName UserHiddenColums UserHiddenGroups  UserHiddenGradeCategories IdNum SectionNum] }
		guest      { set hidden_columns $column_list }
		default    { set hidden_columns $column_list }
	}
	# add user hidden columns
	set hidden_columns [concat $hidden_columns [SelectColValue4User UserHiddenColums $user]]
	# remove hidden columns from sql request
	foreach col $hidden_columns {
		set column_list [removeElementFromList $col $column_list]
	}
	# check which GradesCategory user does not want to see
	set UserHiddenGradeCategories [concat $hidden_columns [SelectColValue4User UserHiddenGradeCategories $user]]
	foreach col $column_list {
		if { [SelectColValue4User $col  _Col_Category_] in $UserHiddenGradeCategories } {
			set column_list [removeElementFromList $col $column_list]
		}
		if { ( ($permission(GroupName) eq "student") || ($permission(GroupName) eq "dropped") ) && ( [SelectColValue4User $col _Visible_To_Students_] ne "true") } {
			switch $col {
				FirstName {; #nothing bad to see first name}
				LastName  {; #nothing bad to see last name}
				default { set column_list [removeElementFromList $col $column_list]}
			}
		}
	}

	# add UserName column since a lot depends on it knowledge
	if {{UserName} ni $column_list} {
		lappend column_list UserName
	}
	
	set sql_column_str [colList2sqlColStr $column_list]
	# set users of what group user can see, i.e. set WHERE statement
	set where_statement {}
	switch $permission(GroupName) {
		instructor { 
			# hide unwanted user groups
			set user_groups_for_hide [SelectColValue4User UserHiddenGroups $user]
			if {$user_groups_for_hide != {} } {
				foreach grp $user_groups_for_hide {
					if { $where_statement == {} } {
						set where_statement "WHERE GroupName<>\"$grp\""
					} else {
						set where_statement [concat $where_statement "AND GroupName<>\"$grp\""]
					}
				}
			}
		}
		ta         { set where_statement "WHERE GroupName=\"student\"" }
		student    { set where_statement "WHERE UserName=\"$user\"" }
		dropped    { set where_statement "WHERE UserName=\"$user\"" }
		guest      { dbg "Guest must not be allowed to set table view port. Aborting. This line is never executed" msg_level_critical; exit }
		default      { dbg "Default must not be allowed to set table view port. Aborting. This line is never executed." msg_level_critical; exit }
	}
	if { $sql_column_str ne "" } {
		# assign type cast  for different sort_col
		if { [SelectColValue4User $sort_col  _Col_Category_] in [concat $grades_category weighted_column]} {
			set ordered_by_str [concat CAST(\"$sort_col\" AS REAL)] 
		} else {
			set ordered_by_str \"$sort_col\" 
		}
		#get all allowed columns and rows
		set eval_str [concat SELECT $sql_column_str FROM GradesTable $where_statement ORDER BY $ordered_by_str]
		set err [catch {
				db eval $eval_str v {
					if { $show_header } {
						set show_header 0
						puts  {<table class="gradestable" border="1">}
						puts  "<tr>"
						foreach col  $v(*) {
							if { $col in $hidden_columns } continue
							# detect what column category it is
							set category [SelectColValue4User $col _Col_Category_]
							puts -nonewline "<th class=\"$category\"><a href=\"$script_name?action=sort&sortCol=$col\">$col</a>"
							# below list has action and action_label pairs
							set action_list {userhidecolumn}
							switch $col {
								FirstName { lappend action_list changefirstname  }
								LastName  { lappend action_list changelastname  }
								UserName  { lappend action_list changeusername  }
								UserHiddenColums { } 
								UserHiddenGroups { } 
								UserHiddenGradeCategories { } 
								IdNum { } 
								GroupName  {   }
								SectionNum {   }
								default {
									switch $category {
										"weighted_column" {
											# modify actions for weighted_column
											if { $permission(GroupName) eq "instructor" } {
												if { [SelectColValue4User $col _Visible_To_Students_] eq "true" } {
													lappend action_list hidecolfromstudents 
												} else {
													lappend action_list unhidecolfromstudents 
												}
											}
										}
										default {
											lappend action_list changegrades deletecolumn changecolumn 
											if { [SelectColValue4User $col _Visible_To_Students_] eq "true" } {
												lappend action_list hidecolfromstudents 
											} else {
												lappend action_list unhidecolfromstudents 
											}
										}
									}
								}
							}
							set separator {<br>}
							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<a href=\"$script_name?action=$act&columnname=[::ncgi::encode $col]\">"
										puts -nonewline "<img src=\"$act_icon\" alt=\"$act_label\" title=\"$act_label\">"
										puts -nonewline "</a>"
									} else {
										puts -nonewline "$separator<span class=\"column_control_$act\"><a href=\"$script_name?action=$act&columnname=[::ncgi::encode $col]\">"
										puts -nonewline "$act_label"
										puts -nonewline "</a></span>"
									}
								} 
							}
							puts -nonewline "</th>"
							puts ""
						}
						puts "</tr>"
						# show max point values
						puts  "<tr>"
						set eval_str_MP [concat SELECT $sql_column_str FROM GradesTable WHERE UserName=\"_Max_Points_\"]
						set errMaxPoints [catch {
								db eval $eval_str_MP v_MP {
									foreach c $v_MP(*) {
										if { $c in $hidden_columns } continue
										switch $c {
											"FirstName" {set  MaxPointsStr "Max"}
											"LastName"  {set  MaxPointsStr "Possible"}
											"GroupName"  {set  MaxPointsStr ""}
											"UserName"  {set  MaxPointsStr "_Derived_"}
											default    {set  MaxPointsStr  $v_MP($c)}
										}
										puts "<td> <b>$MaxPointsStr</b> </td>"
									}
								}
							} errStat_MP ]
							if { $errMaxPoints } {
								dbg "we should never be here if UserName: _Max_Points_ exist in the table" msg_level_critical
								dbg $errStat_MP msg_level_critical
								htmlErrorMsg $errStat_MP
							}
						puts "</tr>"
						puts  "<tr>"
					} else {
						puts  "<tr>"
					}

					if { [info exist v(UserName)] } {
						set user_shown [htmlReplaceEmptyString $v(UserName)]
					} else {
						set user_shown "_UNSET_"
					}
					foreach index $v(*) {
						if { $index in $hidden_columns } continue
						if { $index != "*" } {
							# detect what column category it is
							set category [SelectColValue4User $index _Col_Category_]
							set max_points [SelectColValue4User $index _Max_Points_]
							set col_value  $v($index)
							if { ([SelectColValue4User GroupName $user_shown] ne "inforow") && ($category eq "weighted_column") && ($max_points != 0) } {
								if { $col_value eq "" } {
									set col_value 0
								}
								# calculate letter grade to Grand Total
								if { $index eq "Grand Total" } {
									set col_value_letter_grade [number2letter_grade $col_value]
								}
								# promote to percent format
								set col_value [format "%04.2f%%" [expr {100.* $col_value} ] ] 
								# add letter grade to Grand Total
								if { $index eq "Grand Total" } {
									set col_value [ concat $col_value "=" <b> $col_value_letter_grade </b>]
								}
							}
							set col_value [htmlReplaceEmptyString $col_value]
							switch  $index {
								GroupName  {
									if { [isActionGranted changegroupname $permission_list $user] && ($user_shown ne "_UNSET_")  } {
										set action_html_code "$separator<span class=\"controls\"><a href=\"$script_name?action=changegroupname&user2modify=$user_shown\">Change</a></span>"
									} else {
										set action_html_code {}
									}
									puts -nonewline "<td class=\"$category\">$col_value $action_html_code</td>"
								}
								default    {puts -nonewline "<td class=\"$category\">$col_value</td>"}
							}
						}
					}
					puts "</tr>"
				}
			} errStat ]
		if { $err } {
			dbg "we should never be here if $sortCol exist in the table" msg_level_critical
			dbg $errStat msg_level_critical
			htmlErrorMsg $errStat
		}
		puts  "</table>"
	} else {
		puts {There is no grades yet.}
	}
	puts  {</div>}
}

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 "<div>"
	puts "Available classes are"
	puts "<ul>"
	foreach cdb  [get_list_of_courses_db] {
		set dbfile "$GradebookServerConfig(grades_db_dir)/$cdb"
		if { ![file exists $dbfile] } { continue }

		sqlite3 db $dbfile
		set CourseTitle     [SelectItemFromCourseInfoTable course_title]
		set CourseYear      [SelectItemFromCourseInfoTable course_year]
		set CourseSemester  [SelectItemFromCourseInfoTable course_semester]
		puts "<li><a href=\"$script_root_name/$cdb\">$CourseYear $CourseSemester - $CourseTitle</a>"
		db close
	}
	puts "</ul>"
	puts "</div>"
}

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 "<div class=\"footer\">"
	puts "Execution time $execution_time seconds. <br>"
	puts "GradeBook $VERSION by Eugeniy E. Mikhailov."
	puts "<p> <a href=\"$GradebookServerConfig(html_access_stats_url)\">Access statistics.<a>"
	puts "</div>"
}


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 "<div class=\"header\">"
	puts "<h1>Course grades for $CourseTitle</h1>"
	puts "<p class=date>"
	puts "$CourseYear - $CourseSemester"
	puts "</p>"
	puts "</div>"
}

proc Greetings {} {
	global user password script_name

	set FirstName UnknownFirstName
	set LastName  UnknownLastName


	# get First and Last name info
	set FirstName [SelectColValue4User FirstName $user]
	set LastName  [SelectColValue4User LastName  $user]
	
	puts "<div class=\"greetings\">"
	puts "<span class=login_info>$FirstName $LastName</span>, you  are logged in as <span class=login_info>$user</span>."
	#puts "<a href=\"$script_name?action=logoff\">logoff</a>"
	puts "</div>"
	
}

proc askToLogin {} {
	global script_name
	global user_requested password
	puts "<div class=\"login\">"
	puts "Either you are here first time or you password and user name does not match. <br>"
	puts "Please login <br>"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts "Login (email): <input type=\"text\" name=\"user\" value=\"$user_requested\"><br>"
	puts {Password: <input type="password" name="password"><br>}
	puts {<input type="hidden" name="action" value="logon"/>}
	puts {<input type="submit" value="Submit" />}
	puts {<br>}
	puts {If you don not know your password, fill in login box and push <input type="submit" name="subaction" value="Reset password" />}
	puts {</form>}
	puts "</div>"
}

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"
	}
	#now it is safe to delete temporary file
	file delete $tmp_msg_file
}

proc LogMeOn {} {
	#more correctly set cookies
	global user_requested password
	set user_requested [::ncgi::value user guest]
	set password [::ncgi::value password guest]
	dbg "Logging in and setting cookies" msg_level_info
	::ncgi::setCookie  -name user -value $user_requested
	::ncgi::setCookie  -name password -value $password
	
	set subaction [::ncgi::value subaction {}]
	if { $subaction eq "Reset password" } {
		return resetforgottenpassword
	}
	return defaultview
}

proc LogMeOff {} {
	dbg "Logging off" msg_level_info
	global user password
	#set user guest
	set password {}
	#::ncgi::setCookie  -name user -value $user
	::ncgi::setCookie  -name password -value $password
}

proc SetSortColumn {} {
	global sortCol 
	set sortCol [::ncgi::value sortCol LastName]
	::ncgi::setCookie  -name sortCol -value $sortCol
}

proc isActionGranted { action permission_list user } {
	array set permission $permission_list
	dbg "$user requested action $action" msg_level_info
	if { $action == "defaultview" } { 
		# this one permitted to everyone
		dbg "requested action $action for user $user is granted" msg_level_info
		return 1;
	}
	if { $action == "resetforgottenpassword" } {
		# this one permitted to everyone
		dbg "requested action $action for user $user is granted" msg_level_info
		return 1;
	}
	if { ![info exist permission($action) ] } {
		dbg "requested UNKNOWN action $action for user $user is not granted" msg_level_warning
		htmlErrorMsg "requested UNKNOWN action $action"
		return 0;
	}

	if {$permission($action) } {
		dbg "requested action $action for user $user is granted" msg_level_info
		return 1;
	} else {
		dbg "requested action $action for user $user is not granted" msg_level_info
		return 0;
	}
}

proc ChoseAction {action permission_list user} {
	array set permission $permission_list
	dbg "requested action: $action" msg_level_info
	if { [isActionGranted $action $permission_list $user] } {

		switch $action {
			sort             { SetSortColumn; ChoseAction defaultview $permission_list $user } 
			addcolumn        { 
				           AddColumn          $permission_list  $user;
				           htmlDefaultView    $permission_list  $user
					 } 
			addcolumnrequest { AddColumnRequest   $permission_list  $user } 
			deletecolumn     { 
			                   DeleteColumn       $permission_list  $user;
				           htmlDefaultView    $permission_list  $user
			                 } 
			changegrades	 { ChangeGrades       $permission_list  $user }	 
			updategrades     { UpdateGrades       $permission_list  $user 
				           htmlDefaultView    $permission_list  $user
			                 } 
			changecolumn     { ChangeColumn       $permission_list  $user }
			updatecolumn     { UpdateColumn       $permission_list  $user 
				           htmlDefaultView    $permission_list  $user
					 }
			showcontrols     { ShowControls       $permission_list  $user } 
			hidecolfromstudents   { HideColumnFromStudents     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			unhidecolfromstudents { UnHideColumnFromStudents     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userhidecolumn   { UserHideColumn     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userunhidecolumn { UserUnHideColumn     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userhidegroup   { UserHideGroup     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userunhidegroup { UserUnHideGroup     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userhidegradecategory   { UserHideGradeCategory     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			userunhidegradecategory { UserUnHideGradeCategory     $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			showgrades       { htmlGradesTable db $permission_list  $user }
			edit_grades_categories   { EditGradesCategories db $permission_list  $user }
			update_grades_categories { UpdateGradesCategores db $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			editcourseinfo   { EditCourseInfo db $permission_list  $user }
			updatecourseinfo { UpdateCourseInfo db $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			editnewuserinfo  { EditNewUserInfo db $permission_list  $user }
			addnewuserinfo   { AddNewUserInfo db $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			choosenewpassword  { ChooseNewPassword db $permission_list  $user }
			setnewpassword     { SetNewPassword    db $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			resetforgottenpassword      { ResetForgottenPassword   $permission_list  $user }
			changegroupname   { ChangeGroupName  $permission_list  $user }
			setgroupname      { SetGroupName  $permission_list  $user 
				           htmlDefaultView    $permission_list  $user }
			defaultview      { htmlDefaultView    $permission_list  $user }
			default          { htmlErrorMsg "requested action <b>$action</b> is granted but not implemented yet" }
		}	
	} else {
		# this action is permitted to everyone by default
		#ChoseAction defaultview $permission_list $user
		dbg "action $action isn not permitted for $user" msg_level_info
	}
}

proc ChangeGroupName {permission_list user } {
	global script_name
	set modified_user [::ncgi::value user2modify {}]

	set current_group_name [SelectColValue4User GroupName $modified_user]
	set FirstName [SelectColValue4User FirstName $modified_user]
	set LastName [SelectColValue4User LastName $modified_user]
	puts "<div class=changegroupname>"
	puts "New group name for $FirstName $LastName with user name $modified_user"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts {GroupName: <select name="groupname">}
	# opt list has option name and corresponding text pairs
	set opt_list [list \
			student student\
			dropped "Dropped Student"\
	    ta ta\
			instructor instructor
		]
	foreach {name txt} $opt_list {
		set out_str {}
		if { $name eq $current_group_name } {
			append out_str {<option value="} $name {" selected>} $txt {</option>}
		} else {
			append out_str {<option value="} $name {">} $txt {</option>}
		}
		puts $out_str
	}	
	puts {</select> <br>}
	puts {<input type="hidden" name="action" value="setgroupname"/>}
	puts "<input type=\"hidden\" name=\"user2modify\" value=\"$modified_user\"/>"
	puts {<input type="submit" name="subaction" value="Submit" />}
	puts {<input type="submit" name="subaction" value="Cancel" />}
	puts {</form>}
	puts "</div>"
}

proc SetGroupName { permission_list user } {
	set subaction      [::ncgi::value subaction {}]
	set modified_user [::ncgi::value user2modify {}]
	set new_group_name [::ncgi::value groupname {}]

	if { $subaction eq "Cancel" } {
		return
	}

	if { $new_group_name eq "" } {
		htmlErrorMsg "Empty groupname are not permitted"
		return
	}

	if { $subaction eq "Submit" } {
		UpdateColValue4UserNameNonWeb GroupName $modified_user $new_group_name
	}
}


proc ChooseNewPassword {db permission_list user } {
	global script_name

	puts "<div class=choosenewpassword>"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts "Please type new password:  <input type=\"password\" name=\"newpassword\" ><br>"
	puts {<input type="hidden" name="action" value="setnewpassword"/>}
	puts {<input type="submit" name="subaction" value="Submit" />}
	puts {<input type="submit" name="subaction" value="Cancel" />}
	puts {</form>}
	puts "</div>"
}

proc Set_New_Password_Non_Web {user newpassword} {
	global GradebookServerConfig
	if { $newpassword eq "" } {
		dbg "Attempt to set empty password which is not permitted" msg_level_info
		return
	}
	set password_hash [::md5::md5 -hex $newpassword]
	
	set err [catch {
		sqlite3 pdb $GradebookServerConfig(passwords_db_file)
	} errStat ]
	if { $err } {
		dbg  "$errStat with filename $GradebookServerConfig(passwords_db_file)" msg_level_critical
		return
	} 

	if { ![ is_User_Registered_in_Passwords_DB $user ] } {
		set sql_str [concat INSERT INTO  PasswordsTable (UserName, PasswordHash) VALUES('$user', '$password_hash')]
	} else {
		set sql_str [concat UPDATE  PasswordsTable SET \"PasswordHash\"=\'$password_hash\' where UserName=\"$user\"]
	}

	set err [catch {
		pdb eval $sql_str
	} errStat ]
	if { $err } {
		htmlErrorMsg  $errStat 
		dbg  "the following error happen: $errStat" msg_level_warning
	} 
}

proc SetNewPassword {db permission_list user } {
	global script_name

	set subaction      [::ncgi::value subaction {}]
	set newpassword      [::ncgi::value newpassword {}]

	if { $subaction eq "Cancel" } {
		return
	}

	if { $newpassword eq "" } {
		dbg "Attempt to set empty password which is not permitted" msg_level_info
		htmlErrorMsg "Empty passwords are not permitted"
		return
	}

	if { $subaction eq "Submit" } {
		Set_New_Password_Non_Web $user $newpassword
	}
}


proc AddNewUserInfo {db permission_list user } {
	set subaction      [::ncgi::value subaction {}]
	set first_name     [::ncgi::value first_name {}]
	set last_name      [::ncgi::value last_name {}]
	set login          [::ncgi::value login {}]
	set id_number      [::ncgi::value id_number {}]
	set section_number [::ncgi::value section_number {}]
	set group_name     [::ncgi::value group_name {}]

	if { $subaction eq "Cancel" } {
		return
	}

	if { $login eq "" } {
		htmlErrorMsg "Empty login names are not permitted"
		return
	}

	if { [SelectColValue4User UserName $login] ne "" } {
		htmlErrorMsg "User with login $login already exists"
		return
	}

	set permitted_groups [list instructor ta student guest]
	if { $subaction eq "Submit" } {
		if { $group_name ni $permitted_groups } {
			htmlInfoMsg "Unknown group name {$group_name} replaced with {guest}."
			set group_name guest
		}
		AddUserNonWeb $first_name $last_name $login $group_name $id_number $section_number
	}
}

proc EditNewUserInfo {db permission_list user } {
	global script_name

	puts "<div class=editnewuserinfo>"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts "First Name:    <input type=\"text\" name=\"first_name\" ><br>"
	puts "Last Name:     <input type=\"text\" name=\"last_name\" ><br>"
	puts "Login (email): <input type=\"text\" name=\"login\" ><br>"
	puts "Id Number: <input type=\"text\" name=\"id_number\" ><br>"
	puts "Section Number: <input type=\"text\" name=\"section_number\" ><br>"
	puts "Group Name: <input type=\"text\" name=\"group_name\" ><br>"
	puts {<input type="hidden" name="action" value="addnewuserinfo"/>}
	puts {<input type="submit" name="subaction" value="Submit" />}
	puts {<input type="submit" name="subaction" value="Cancel" />}
	puts {</form>}
	puts "</div>"
}

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 "<div class=editcourseinfo>"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts "Course title:    <input type=\"text\" name=\"course_title\" value=\"$CourseTitle\"><br>"
	puts "Course year:     <input type=\"text\" name=\"course_year\" value=\"$CourseYear\"><br>"
	puts "Course Semester: <input type=\"text\" name=\"course_semester\" value=\"$CourseSemester\"><br>"
	puts {<input type="hidden" name="action" value="updatecourseinfo"/>}
	puts {<input type="submit" name="subaction" value="Submit" />}
	puts {<input type="submit" name="subaction" value="Cancel" />}
	puts {</form>}
	puts "</div>"
}

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 <span class=\"controls\"><a href=$script_name?action=defaultview>Refresh</a></span> 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 {<div class="add_new_column">}
	puts "<form name=\"input\"  method=\"post\" />"
	set out_str {}
	append out_str {Column Name: <input type="text" name="newcolumnname" value="} $columnname {"><br>}
	puts $out_str
	set out_str {}
	append out_str {Category: <select name="category" value="} $category  {">}
	puts $out_str
	foreach {name} $grades_category {
		set txt [grade_Category2html_name $name]
		set out_str {}
		if { $name eq $category } {
			append out_str {<option value="} $name {" selected>} $txt {</option>}
		} else {
			append out_str {<option value="} $name {">} $txt {</option>}
		}

		puts $out_str
	}	
	puts {</select> <br>}
	set out_str {}
	append out_str {Max Point Possible:<input type="text" name="maxpointpossible" value="} $maxpoints {"> <br>}
	puts $out_str
	puts {<input type="hidden" name="action" value="updatecolumn"/>}
	set out_str {}
	append out_str {<input type="hidden" name="oldcolumnname" value="} $columnname {"/>}
	puts $out_str
	puts {<input type="submit" value="Submit" />}
	puts {</form>}
	puts {</div>}
}

proc UpdateColumn { permission_list user } {
	set oldcolumnname [::ncgi::value oldcolumnname {}]
	set newcolumnname [::ncgi::value newcolumnname {}]
	set column_category [::ncgi::value category {}]
	set maxpointpossible [::ncgi::value maxpointpossible {}]

	# transform colnames to sql safe form
	set oldcolumnname [ColName2SqlSafeForm $oldcolumnname]
	set newcolumnname [ColName2SqlSafeForm $newcolumnname]

	# first we update category and maxpointpossible values of the old columnname
	UpdateColValue4UserNameNonWeb $oldcolumnname _Col_Category_ $column_category
	UpdateColValue4UserNameNonWeb $oldcolumnname _Max_Points_   $maxpointpossible

	calculteWeightedTotals

	if { $newcolumnname eq $oldcolumnname } {
		# no need to mess with renaming
		return
	}
	if { $newcolumnname == "" } {
		htmlErrorMsg  "empty column names are not permitted"
		return
	}
	set eval_str [concat SELECT * FROM GradesTable ]
	set err [catch {db eval $eval_str v {} } errStat]
	set old_column_list $v(*)
	# check if column with the suggested new name is already exist
	foreach cname $old_column_list {
		if { $cname eq $newcolumnname } {
			htmlErrorMsg  "The column name <b>$newcolumnname</b> is already exist"
			return
		}
	}
	# sqlite does not allow rename columns
	# I will first create new column identical to the old one
	AddColumnNonWeb  $newcolumnname $column_category $maxpointpossible 
	set sql_str [concat UPDATE  GradesTable SET \"$newcolumnname\"=\"$oldcolumnname\"]
	set err [catch {db eval $sql_str } errStat]
	# then delete the old one
	DeleteColumnNonWeb $oldcolumnname
}

proc UpdateColValue4UserNameNonWeb { columnname username val } {
					set sql_str [concat UPDATE  GradesTable SET \"$columnname\"=\'$val\' where UserName=\"$username\"]
					set err2 [catch {
						db eval $sql_str
					} errStat2 ]
					if { $err2 } {
						htmlErrorMsg  $errStat2 
						dbg  "the following error happen: $errStat2" msg_level_critical
					} 
}

proc UpdateColValue4GroupNameNonWeb { columnname groupname val } {
					set sql_str [concat UPDATE  GradesTable SET \"$columnname\"=\'$val\' where GroupName=\"$groupname\"]
					set err2 [catch {
						db eval $sql_str
					} errStat2 ]
					if { $err2 } {
						htmlErrorMsg  $errStat2 
						dbg  "the following error happen: $errStat2" msg_level_critical
					} 
}

proc UpdateGrades { permission_list user } {
	global script_name
	set subaction [::ncgi::value subaction {}]
	set columnname [::ncgi::value columnname {}]
	set nv [::ncgi::nvlist]
	array set colval  $nv
	if { $subaction eq "Submit" } {
		set eval_str "SELECT UserName  FROM GradesTable"
		set err [catch {
				db eval $eval_str v {
					if { [info exist colval($v(UserName))] } {	
						UpdateColValue4UserNameNonWeb $columnname $v(UserName) $colval($v(UserName))
					}
				}
			} errStat ]
		if { $err } {
			htmlErrorMsg  $errStat 
			dbg  "the following error happen: $errStat" msg_level_critical
		} 
	}

	calculteWeightedTotals
}

proc ChangeGrades { permission_list user } {
	global script_name
	set columnname [::ncgi::value columnname {}]
	if { $columnname != "" } {
		# output only selected columns
		set column_list {}
		lappend column_list FirstName LastName UserName
		lappend column_list \"$columnname\"
		set sql_column_list [join $column_list ","]
		puts {<div class="changegrades">}
		puts {If student have excuse for the grade to be excluded, use keyword <b>excuse</b> in conjunction with a reason.}
		puts {<br>}
		puts {For example : "medical excuse".}
		puts {<div class="gradestable">}
		puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
		# output only selected columns
		set eval_str "SELECT $sql_column_list  FROM GradesTable WHERE UserName<>'_Col_Category_' AND UserName<>'_Max_Points_' AND GroupName='student' ORDER BY LastName"
		set show_header 1
		set err [catch {
				db eval $eval_str v {
					if { $show_header } {
						set show_header 0
						puts  {<table class="gradestable" border="1">}
						puts  "<tr>"
						foreach col  $v(*) {
							puts -nonewline "<th>$col</th>"
						}
						puts  "<tr>"
					} else {
						puts  "<tr>"
					}
					foreach index $v(*) {
						if { $index != "*" } {
							if { $index eq $columnname } {
								#column with grade
								puts "<th><input type=\"text\" name=\"$v(UserName)\" value=\"$v($columnname)\" size=5></th>"
							} else {
								puts -nonewline "<td>$v($index)</td>"
							}
						}
					}
					puts "</tr>"
				}
			} errStat ]
		puts  "</table>"
		if { $err } {
			htmlErrorMsg  $errStat 
			dbg  "the following error happen: $errStat" msg_level_critical
		} 
		puts {<input type="hidden" name="action" value="updategrades"/>}
		puts [concat <input type="hidden" name="columnname" value="$columnname"/>]
		puts {<input type="submit" name="subaction" value="Submit" />}
		puts {<input type="submit" name="subaction" value="Cancel" />}
		puts {</form>}
		puts {</div>}
		puts {</div>}
		#puts "<a href=\"$script_name\">Cancel changes</a>"
		
	} else {
		htmlErrorMsg  "empty column names are not permitted"
	}
}

proc removeElementFromList { element2remove old_list } {
	set new_list {}
	foreach element $old_list {
		if { $element2remove ne $element } {
			lappend new_list $element
		}
	}
	return $new_list
}


proc DeleteColumnNonWeb { columnname } {
	DeleteColumnFromTable GradesTable $columnname

	calculteWeightedTotals
}

proc DeleteColumn { permission_list user } {
	global script_name
	set columnname [::ncgi::value columnname {}]
	DeleteColumnNonWeb $columnname
}

proc AddColumnNonWeb { columnname2add column_category maxpointpossible {sql_type {text}} } {
	if { $columnname2add != "" } {

		set eval_str [concat ALTER TABLE GradesTable ADD \"$columnname2add\" $sql_type]
		set err [catch {db eval $eval_str } errStat]
		if { $err } {
			htmlErrorMsg  $errStat 
			dbg  "the following error happen: $errStat" msg_level_critical
		} 

		UpdateColValue4UserNameNonWeb $columnname2add _Col_Category_ $column_category
		UpdateColValue4UserNameNonWeb $columnname2add _Max_Points_   $maxpointpossible

		if { $column_category ne "weighted_column" } {
			calculteWeightedTotals
		}
	} else {
		htmlErrorMsg  "empty column names are not permitted"
	}
}

proc AddColumn { permission_list user } { 
	global script_name
	set columnname2add [::ncgi::value columnname2add {}]
	set column_category [::ncgi::value column_category {}]
	set maxpointpossible [::ncgi::value maxpointpossible {}]
	set columnname2add [ColName2SqlSafeForm $columnname2add]
	AddColumnNonWeb  $columnname2add $column_category $maxpointpossible 
}

proc AddColumnRequest { permission_list user } { 
	global script_name
	#global grades_category
	set grades_category [ get_grades_category ]
	puts {<div class="add_new_column">}
	puts "<form name=\"input\"  method=\"post\" />"
	puts {Column Name: <input type="text" name="columnname2add"><br>}
	puts {Category: <select name="column_category">}
	foreach {name} $grades_category {
		set txt [grade_Category2html_name $name]
		set out_str {}
		append out_str {<option value="} $name {">} $txt {</option>}
		puts $out_str
	}	
	puts {</select> <br>}
	puts {Max Point Possible:<input type="text" name="maxpointpossible"><br>}
	puts {<input type="hidden" name="action" value="addcolumn"/>}
	puts {<input type="submit" value="Submit" />}
	puts {</form>}
	puts {</div>}

}

proc ShowControls { permission_list user } {
	array set permission $permission_list
	global script_name
	#global grades_category
	set grades_category [ get_grades_category ]
	dbg "outputting contol list" msg_level_info
	puts "<div class=\"controls\">"
	set action_list [ list  \
			defaultview "Refresh"\
			addcolumnrequest "Add Column"\
			editcourseinfo "Edit Course Info"\
			editnewuserinfo "Add new user"\
			choosenewpassword "Choose new password"\
			edit_grades_categories "Edit Grades Categories and Weights"\
			logoff "Logoff"\
		]
	set separator { }
	foreach {act act_label} $action_list {
		if { [isActionGranted $act $permission_list $user] } {
			puts -nonewline "$separator<span class=\"controls\"><a href=$script_name?action=$act>$act_label</a></span>"
		} 
	}
	puts "<br>"
	# unhide user hidden columns actions
	set currently_hidden_columns [SelectColValue4User UserHiddenColums $user]
	if { $currently_hidden_columns ne "" } {
		puts {Unhide columns: }
		foreach col $currently_hidden_columns {
			puts "<span class=\"controls\"><a href=\"$script_name?action=userunhidecolumn&columnname=[::ncgi::encode $col]\">$col</a></span>"
		}
	}
	# hide user groups 
	set user_groups_for_hide [list inforow student ta instructor 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 "<br>"
			puts "HideGroup: "
			foreach grp $user_groups_for_hide {
				puts "<span class=\"controls\"><a href=\"$script_name?action=userhidegroup&groupname=[::ncgi::encode $grp]\">$grp</a></span>"
			}
		}
	}
	if { [isActionGranted userunhidegroup $permission_list $user] } {
		if { $currently_hidden_groups ne "" } {
			puts "<br>"
			puts {Unhide groups: }
			foreach grp $currently_hidden_groups {
				puts "<span class=\"controls\"><a href=\"$script_name?action=userunhidegroup&groupname=[::ncgi::encode $grp]\">$grp</a></span>"
			}
		}
	}

	# 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 "<br>"
			puts "Hide grades in category: "
			foreach ctgry $grades_category_for_hide {
				puts "<span class=\"controls\"><a href=\"$script_name?action=userhidegradecategory&grades_category=[::ncgi::encode $ctgry]\">$ctgry</a></span>"
			}
		}
	}
	if { [isActionGranted userunhidegroup $permission_list $user] } {
		if { $currently_hidden_grades_category ne "" } {
			puts "<br>"
			puts {Unhide grades in category: }
			foreach ctgry $currently_hidden_grades_category {
				puts "<span class=\"controls\"><a href=\"$script_name?action=userunhidegradecategory&grades_category=[::ncgi::encode $ctgry]\">$ctgry</a></span>"
			}
		}
	}
	
	puts "</div>"	
}

proc Create_Passwords_Table {} {
	dbg  "Creating PasswordsTable" msg_level_info
	set err [catch {pdb eval {CREATE TABLE PasswordsTable(UserName text, PasswordHash text)} } errStat] 
	if { $err } {
		dbg  "While creating PasswordsTable the following error happen: $errStat" msg_level_critical
	} 
}

proc is_User_Registered_in_Passwords_DB { user_requested } {
	# note the use of : instead of $ (this sqlite feature)
	set eval_str {SELECT UserName FROM PasswordsTable WHERE UserName=:user_requested}
	set err [catch {
		pdb eval $eval_str registered_user_names_array {}
	} errStat ]
	if { $err } {
		if { $errStat eq "no such table: PasswordsTable" } {
			Create_Passwords_Table 
		} else {
			htmlErrorMsg  "Problem accessing passwords database, please, contact system administrator"
			dbg  "$errStat" msg_level_warning
		}
	} 
	if { ![ info exist registered_user_names_array(UserName) ] } {
		dbg "$user_requested does not exist in the passwords DB" msg_level_info
		return false
	} 
	return true
}

proc Authenticate_User { user_requested password } {
	# return the username of authentificated user or a guest like username
	global GradebookServerConfig
	set err [catch {
		sqlite3 pdb $GradebookServerConfig(passwords_db_file)
	} errStat ]
	if { $err } {
		htmlErrorMsg  "Problem accessing passwords database, please, contact system administrator"
		dbg  "$errStat with filename $GradebookServerConfig(passwords_db_file)" msg_level_critical
		return __non_existing_user__
	} 

	dbg "access rights check for user: $user_requested" msg_level_info
	set PasswordHash [::md5::md5 -hex $password]

	if { ![ is_User_Registered_in_Passwords_DB $user_requested ] } {
		pdb close
		return __non_existing_user__
	}

	set eval_str [list SELECT UserName FROM PasswordsTable WHERE UserName='$user_requested' AND PasswordHash='$PasswordHash']
	set err [catch {
		pdb eval $eval_str valid_user_name_array {}
	} errStat ]
	if { $err } {
		htmlErrorMsg  "Problem accessing passwords database, please, contact system administrator"
		dbg  "$errStat" msg_level_critical
	} 

	if { [ info exist valid_user_name_array(UserName) ] } {
		dbg "Credentials match for $user_requested in the passwords DB" msg_level_info
		set user  $valid_user_name_array(UserName);
	} else {
		dbg "Credentials for $user_requested  do not match stored in password DB" msg_level_info
		set user __wrong_password_user__
	}
	
	pdb close
	return $user
}

proc AccessGroupRights {db  user } {
	dbg "access rights check for user: $user" msg_level_info
	set eval_str [list SELECT GroupName FROM GradesTable WHERE UserName='$user']
	db eval $eval_str group_name_array {}
	if { [ info exist group_name_array(GroupName) ] } {
		set group $group_name_array(GroupName);
	} else {
		set group guest
	}
	dbg "Detected group is $group" msg_level_info
	set eval_str [list SELECT actionname,$group FROM AccessRightsTable ]
	set permission_list [list GroupName $group]
	db eval $eval_str permissions { lappend permission_list $permissions(actionname) $permissions($group) }
	dbg "permissions for user $user belonging to the group $group are: $permission_list" msg_level_info
	return $permission_list
}


proc htmlGradesTable {db permission_list  user} {
	array set permission $permission_list
	global sortCol
	switch $permission(GroupName) {
		guest      { }
		student         { htmlDBout db $permission_list $user $sortCol}
		dropped         { htmlDBout db $permission_list $user $sortCol}
		ta         { htmlDBout db $permission_list $user $sortCol}
		instructor { htmlDBout db $permission_list $user $sortCol}
		default    { }
	}
}

proc htmlDefaultView { permission_list user } {
	ChoseAction showcontrols $permission_list $user
	ChoseAction showgrades $permission_list $user
}

proc htmlHeader {} {
puts {
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
	<meta http-equiv="Content-Type" content= "text/html; charset=us-ascii" />
	<title>Grade Book</title>
	<link rel="stylesheet" type="text/css" href="/~evmik/GradeBook.css" />
</head>
}
}

proc htmlHeaderDBSelector {} {
puts {
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
	<meta http-equiv="Content-Type" content= "text/html; charset=us-ascii" />
	<title>Grade Books Selector</title>
	<link rel="stylesheet" type="text/css" href="/~evmik/GradeBook.css" />
</head>
}
}

##################### end of procs ####################################

# vim: ts=2 sw=2 foldmethod=indent: