path: root/GradeBook.tcl

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

# internal version of this code
set VERSION 1.0

package require sqlite3
package require ncgi 
package require md5

::ncgi::parse

# defaults
set sortCol LastName
set user guest
set password guest
set action defaultview
# defaults end

# read cookies
set user [::ncgi::cookie user]
set sortCol [::ncgi::cookie sortCol]
set password [::ncgi::cookie password]
set action [::ncgi::value action defaultview]
# end of read cookies

if { [catch {set script_name $env(SCRIPT_NAME)} errStat] } { set script_name unknown}


# ########################## procs begin #################################
proc dbg {msg {level 1}} {
	if { $level <=2 } {
		set fid [open log a+]
		puts $fid $msg 
		close $fid
	}
}

set dbfile "./testdb"

#set url_base

sqlite3 db $dbfile

proc CreatePasswordsTable {db} {
	db eval {CREATE TABLE PasswordsTable(UserName text, PasswordHash text, GroupName text)}
	set eval_str [list INSERT INTO PasswordsTable VALUES('instructor', '[::md5::md5 -hex qwerty]', 'instructor')]
	db eval $eval_str
	set eval_str [list INSERT INTO PasswordsTable VALUES('ta', '[::md5::md5 -hex qwerty]', 'ta')]
	db eval $eval_str

	set eval_str [list INSERT INTO PasswordsTable VALUES('jhn', '[::md5::md5 -hex qwerty]', 'student')]
	db eval $eval_str
	set eval_str [list INSERT INTO PasswordsTable VALUES('ale', '[::md5::md5 -hex qwerty]', 'student')]
	db eval $eval_str
	set eval_str [list INSERT INTO PasswordsTable VALUES('dan', '[::md5::md5 -hex qwerty]', 'student')]
	db eval $eval_str
}

proc CreateGradesTable {db} {
	db eval {CREATE TABLE GradesTable(FirstName text, LastName text, UserName text,  HW01 real)}

	set eval_str [list INSERT INTO GradesTable VALUES('John','Lname1', 'jhn',   7)]
	db eval $eval_str
	set eval_str [list INSERT INTO GradesTable VALUES('Ale','Lname2', 'ale',   5)]
	db eval $eval_str
	set eval_str [list INSERT INTO GradesTable VALUES('Dan','Lname3', 'dan',   3)]
	db eval $eval_str
}

proc CreateAccessRightsTable {db} {
	db eval {CREATE TABLE AccessRightsTable(actionname text,               instructor integer, ta integer, student integer,  guest integer)}
	# guest should have no rights make sure that 0 is evereywhere
	db eval {INSERT INTO AccessRightsTable VALUES('showgrades',            1,                  1,          1,                0)}
	db eval {INSERT INTO AccessRightsTable VALUES('sort',                  1,                  1,          0,                0)}   
	db eval {INSERT INTO AccessRightsTable VALUES('addcolumnrequest',      1,                  1,          0,                0)}  
	db eval {INSERT INTO AccessRightsTable VALUES('addcolumn',             1,                  1,          0,                0)}
	db eval {INSERT INTO AccessRightsTable VALUES('deletecolumn',          1,                  1,          0,                0)}
	db eval {INSERT INTO AccessRightsTable VALUES('renamecolumn',          1,                  1,          0,                0)}
	db eval {INSERT INTO AccessRightsTable VALUES('editcolumn',            1,                  1,          0,                0)}
	db eval {INSERT INTO AccessRightsTable VALUES('showcontrols',          1,                  1,          0,                0)}
}

proc htmlDBout {db permission_list {sort_col {}}} {
	array set permission $permission_list
	global script_name
	set defSortCol LastName 

	if { $sort_col == {} } {
		set sort_col $defSortCol 
		dbg "empty sort col changed to $sort_col" 4
	} 
	# testing for the existense of the sorting column
	set eval_str [list SELECT * FROM GradesTable ORDER BY $sort_col]
	set err [catch {db eval $eval_str } errStat]
	if { $err } {
		dbg $errStat 3
		dbg "changing to default sorting column $defSortCol" 3
		set sort_col $defSortCol
	}

	set show_header 1
	# show the table with grades
	set eval_str [list SELECT * FROM GradesTable ORDER BY $sort_col]
	set err [catch {
			db eval $eval_str v {
				if { $show_header } {
					set show_header 0
					puts  {<table border="1">}
					puts  "<tr>"
					foreach col  $v(*) {
						puts -nonewline "<th><a href=$script_name?action=sort&sortCol=$col>$col</a>"
						# below list has action and action_label pairs
						set action_list [list editcolumn edit deletecolumn delete renamecolumn rename]
						set separator {<br>}
						foreach {act act_label} $action_list {
							if { [info exist permission($act) ] } {
								if { $permission($act) } {
									puts -nonewline "$separator<a href=$script_name?action=$act&columnname=[::ncgi::encode $col]>$act_label</a>"
								}
							} 
						}
						puts -nonewline "</th>"
					}
					puts "</tr>"
					puts  "<tr>"
				} else {
					puts  "<tr>"
				}
				foreach index $v(*) {
					if { $index != "*" } {
						puts -nonewline "<td>$v($index)</td>"
					}
				}
				puts "</tr>"
			}
		} errStat ]
	if { $err } {
		dbg "we should never be here if $sortCol exist in the table" 1
		dbg $errStat 1

	}
	puts  "</table>"
}

proc htmlTop {permission_list} {
	array set permission $permission_list
	if { $permission(GroupName) == "guest" } {
		askToLogin
	} else {
		LogOffOption
	}

}

proc htmlBottom {permission_list} {
	array set permission $permission_list
	global VERSION
	puts "<div>"
	puts "GradeBook $VERSION code is written by Eugeniy Mikhailov"
	puts "</div>"
}

proc LogOffOption {} {
	global user password script_name
	puts "<div>"
	puts "You are logged in as $user do you wish to "
	puts "<a href=\"$script_name?action=logoff\">logoff</a>"
	puts "</div>"
	
}

proc askToLogin {} {
	global script_name
	puts "Either you are here first time or you password and user name does not match. <br>"
	puts "Please login <br>"
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts {Login: <input type="text" name="user"><br>}
	puts {Password: <input type="password" name="password"><br>}
	puts {<input type="hidden" name="action" value="logon"/>}
	puts {<input type="submit" value="Submit" />}
	puts {</form>}
}




#proc CheckAccessRights { user password} {}
#proc IsUserknown {} {return 1}

#proc SetLoginInfo {} {
	#global user password
	#set isAccessGranted [IsUserknown]
	#if { $isAccessGranted } {
		#dbg "access granted to user $user" 
	#}

	#set access_rights [CheckAccessRights $user $password]

#}

proc LogMeOn {} {
	global user password
	set user [::ncgi::value user guest]
	set password [::ncgi::value password guest]
	dbg "Logging in and setting cookies" 
	::ncgi::setCookie  -name user -value $user
	::ncgi::setCookie  -name password -value $password
}

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

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

proc isActionGranted { action permission_list user } {
	array set permission $permission_list
	if { $action == "defaultview" } { 
		# this one permitted to everyone
		return 1;
	}
	if { [info exist permission($action) ] && $permission($action) } {
		dbg "requested action $action is granted" 4
		return 1;
	} else {
		dbg "requested action $action is not granted" 4
		return 0;
	}
}

proc ChoseAction {action permission_list user} {
	array set permission $permission_list
	dbg "requested action: $action" 3
	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
			                 } 
			renamecolumn     { } 
			showcontrols     { ShowControls       $permission_list  $user } 
			showgrades       { htmlGradesTable db $permission_list  $user }
			defaultview      { htmlDefaultView    $permission_list  $user }
			default          { }
		}	
	} 
}

proc DeleteColumn { permission_list user } {
	global script_name
	set columnname [::ncgi::value columnname {}]
	if { $columnname != "" } {
		set eval_str [concat SELECT * FROM GradesTable ]
		set err [catch {db eval $eval_str v {} } errStat]
		set old_column_list $v(*)
		# removing the column name to be deleted from total list
		set new_column_list {}
		foreach cname $old_column_list {
			if { $cname ne $columnname } {
				lappend new_column_list \"$cname\"
			}
		}
		set sql_new_column_list [join $new_column_list ","]
		set eval_str "BEGIN TRANSACTION;
			CREATE TEMPORARY TABLE GradesTable_backup($sql_new_column_list);
			INSERT INTO GradesTable_backup SELECT $sql_new_column_list FROM GradesTable;
			DROP TABLE GradesTable;
			CREATE TABLE GradesTable($sql_new_column_list);
			INSERT INTO GradesTable SELECT $sql_new_column_list FROM GradesTable_backup;
			DROP TABLE GradesTable_backup;
			COMMIT;"
		set err [catch {db eval $eval_str  } errStat]
		if { $err } {
			puts "the following error happen: $errStat"
			dbg  "the following error happen: $errStat" 3
		} 
	} else {
		puts "error: empty column names are not permitted"
	}
}


proc AddColumn { permission_list user } { 
	global script_name
	set columnname2add [::ncgi::value columnname2add {}]
	if { $columnname2add != "" } {

		set eval_str [concat ALTER TABLE GradesTable ADD \"$columnname2add\" real]
		puts $eval_str
		set err [catch {db eval $eval_str } errStat]
		if { $err } {
			puts "the following error happen: $errStat"
			dbg  "the following error happen: $errStat" 3
		} 
	
	} else {
		puts "error: empty column names are not permitted"
	}
}

proc AddColumnRequest { permission_list user } { 
	global script_name
	puts "<form name=\"input\" action=\"$script_name\" method=\"post\" />"
	puts {Column Name: <input type="text" name="columnname2add"><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>}

}

proc ShowControls { permission_list user } {
	array set permission $permission_list
	global script_name
	dbg "outputing contol list"
	puts "<div>"	
	set action_list [ list  addcolumnrequest "Add Column" ]
	set separator {}
	foreach {act act_label} $action_list {
		if { [info exist permission($act) ] } {
			if { $permission($act) } {
				puts -nonewline "$separator<a href=$script_name?action=$act>$act_label</a>"
			}
		} 
	}
	puts "</div>"	
}

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

proc htmlStudentGrades { db user } {
	set defSortCol LastName
	global script_name
	set sort_col $defSortCol


	set show_header 1
	# show the table with grades
	set eval_str [list SELECT * FROM GradesTable WHERE UserName='$user' ORDER BY $sort_col]
	set err [catch {
			db eval $eval_str v {
				if { $show_header } {
					set show_header 0
					puts  {<table border="1">}
					puts  "<tr>"
					foreach col  $v(*) {
						puts -nonewline "<th>$col</th>"
					}
					puts "</tr>"
					puts  "<tr>"
				} else {
					puts  "<tr>"
				}
				foreach index $v(*) {
					if { $index != "*" } {
						puts -nonewline "<td>$v($index)</td>"
					}
				}
				puts "</tr>"
			}
		} errStat ]
	if { $err } {
		dbg "we should never be here if $sortCol and $user exist in the table" 1
		dbg $errStat 1

	}
	puts  "</table>"
}


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

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



##################### end of procs ####################################
set timestamp [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"]

#CreatePasswordsTable db
#CreateGradesTable db
#CreateAccessRightsTable db
dbg [::ncgi::names] 4
# logon and logoff actions are granted to everyone
if { $action == "logon"  } { LogMeOn;   set action defaultview }   
if { $action == "logoff" } { LogMeOff;  set action defaultview } 

dbg "===== Connection at $timestamp for user $user ====="
set permission_list [AccessGroupRights db $user $password]

::ncgi::header
htmlTop $permission_list
ChoseAction $action $permission_list $user
#htmlDefaultView     $permission_list $user
#htmlGradesTable db $permission_list  $user
#htmlDBout db $sortCol

htmlBottom $permission_list