1 files changed, 184 insertions, 0 deletions
diff --git a/GradeBook.tcl b/GradeBook.tcl
new file mode 100755
index 0000000..9b5722d
--- /dev/null
+++ b/GradeBook.tcl
@@ -0,0 +1,184 @@
+#!/bin/sh
+# FILE: "/home/evmik/src/my_src/GradeBook/GradeBook.tcl"
+# LAST MODIFICATION: "Tue, 14 Dec 2010 17:15:57 -0500 (evmik)"
+# (C) 2010 by Eugeniy Mikhailov, <evgmik@gmail.com>
+# $Id:$
+# vim:set ft=tcl: \
+exec tclsh "$0" "$@"
+
+#load libtclsqlite3.so.0 Sqlite3
+package require sqlite3
+package require ncgi 
+::ncgi::parse
+
+
+set user [::ncgi::cookie user]
+set password [::ncgi::cookie password]
+set action [::ncgi::value action none]
+
+if { [catch {set script_name $env(SCRIPT_NAME)} errStat] } { set script_name unknown}
+
+#set val [::ncgi::value fd]
+set sortCol [::ncgi::value sortCol LastName]
+
+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 createDB {db} {
+	db eval {CREATE TABLE t1(FirstName text, LastName text, HW01 float)}
+
+	db eval {INSERT INTO t1 VALUES('John','Lname1', 7)}
+	db eval {INSERT INTO t1 VALUES('Ale','Lname2', 5)}
+	db eval {INSERT INTO t1 VALUES('Dan','Lname3',9)}
+	#db1 eval {ALTER TABLE t1 ADD c int }
+}
+
+
+proc htmlDBout {db {sort_col {}}} {
+	#set x [db eval {SELECT * FROM t1 ORDER BY a}]
+	#puts $x
+	global script_name
+	set defSortCol LastName
+
+	# testing for the existense of the sorting column
+	set eval_str [list SELECT * FROM t1 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
+	if { $sort_col == {} } {
+		set sort_col LastName
+	} 
+	# show the table with grades
+	set eval_str [list SELECT * FROM t1 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?sortCol=$col>$col</a></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 {} {
+	global user password
+	if { $user == "guest" && $password == "guest" } {
+		askToLogin
+	} else {
+		LogOffOption
+	}
+
+}
+
+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 "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 ChoseAction {action} {
+	dbg "requeste action: $action" 3
+	switch $action {
+		logon  { LogMeOn }
+		logoff { LogMeOff }
+		default {   }
+	}	
+}
+
+##################### end of procs ####################################
+dbg [::ncgi::names] 4
+dbg "sdaf dsaf $action "
+ChoseAction $action
+
+::ncgi::header
+htmlTop
+htmlDBout db $sortCol
+
+
+