blob: 53f6ac593cd444ba7c7afba56f68e084c8370871 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
#!/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
|
