diff options
Diffstat (limited to 'db_procs.tcl')
| -rwxr-xr-x | db_procs.tcl | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/db_procs.tcl b/db_procs.tcl deleted file mode 100755 index 53f6ac5..0000000 --- a/db_procs.tcl +++ /dev/null @@ -1,184 +0,0 @@ -#!/bin/sh -# FILE: "/mnt/light_huge_archive/home/evmik/src/my_src/GradeBook/db_procs.tcl" -# LAST MODIFICATION: "Tue, 14 Dec 2010 01:15:22 -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 - - - |