adamc@1004
|
1 open Meta
|
adamc@1001
|
2
|
adamc@1001
|
3 functor Make(M : sig
|
adamc@1003
|
4 con paper :: {(Type * Type)}
|
adamc@1003
|
5 constraint [Id, Title] ~ paper
|
adamc@1003
|
6 val paper : $(map meta paper)
|
adamc@1003
|
7
|
adamc@1001
|
8 con review :: {(Type * Type)}
|
adamc@1003
|
9 constraint [Paper, User] ~ review
|
adamc@1003
|
10 val review : $(map meta review)
|
adamc@1001
|
11 end) = struct
|
adamc@1001
|
12
|
adamc@1003
|
13 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
|
adamc@1003
|
14 PRIMARY KEY Id,
|
adamc@1003
|
15 CONSTRAINT Nam UNIQUE Nam
|
adamc@1003
|
16 sequence userId
|
adamc@1003
|
17
|
adamc@1003
|
18 con paper = [Id = int, Title = string] ++ map fst M.paper
|
adamc@1003
|
19 table paper : paper
|
adamc@1003
|
20 PRIMARY KEY Id
|
adamc@1003
|
21 sequence paperId
|
adamc@1003
|
22
|
adamc@1003
|
23 con review = [Paper = int, User = int] ++ map fst M.review
|
adamc@1003
|
24 table review : review
|
adamc@1003
|
25 PRIMARY KEY (Paper, User),
|
adamc@1003
|
26 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
|
adamc@1003
|
27 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
|
adamc@1003
|
28 sequence reviewId
|
adamc@1003
|
29
|
adamc@1003
|
30 cookie login : {Id : int, Password : string}
|
adamc@1003
|
31
|
adamc@1004
|
32 val checkLogin =
|
adamc@1003
|
33 r <- getCookie login;
|
adamc@1003
|
34 case r of
|
adamc@1003
|
35 None => return None
|
adamc@1003
|
36 | Some r =>
|
adamc@1003
|
37 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
|
adamc@1003
|
38 FROM user
|
adamc@1003
|
39 WHERE user.Id = {[r.Id]}
|
adamc@1003
|
40 AND user.Password = {[r.Password]})
|
adamc@1003
|
41
|
adamc@1004
|
42 structure Users = BulkEdit.Make(struct
|
adamc@1004
|
43 con keyName = #Id
|
adamc@1004
|
44 val visible = {Nam = string "Name",
|
adamc@1004
|
45 Chair = bool "Chair?",
|
adamc@1004
|
46 OnPc = bool "On PC?"}
|
adamc@1004
|
47
|
adamc@1004
|
48 val title = "Users"
|
adamc@1004
|
49 val isAllowed =
|
adamc@1004
|
50 me <- checkLogin;
|
adamc@1004
|
51 return (Option.isSome me)
|
adamc@1004
|
52
|
adamc@1004
|
53 val t = user
|
adamc@1004
|
54 end)
|
adamc@1004
|
55
|
adamc@1004
|
56
|
adamc@1003
|
57 fun doRegister r =
|
adamc@1003
|
58 n <- oneRowE1 (SELECT COUNT( * ) AS N
|
adamc@1003
|
59 FROM user
|
adamc@1003
|
60 WHERE user.Nam = {[r.Nam]});
|
adamc@1003
|
61 if n > 0 then
|
adamc@1003
|
62 register (Some "Sorry; that username is taken.")
|
adamc@1003
|
63 else
|
adamc@1003
|
64 id <- nextval userId;
|
adamc@1003
|
65 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
|
adamc@1003
|
66 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
|
adamc@1003
|
67 setCookie login {Id = id, Password = r.Password};
|
adamc@1003
|
68 main ()
|
adamc@1003
|
69
|
adamc@1003
|
70 and register msg = return <xml><body>
|
adamc@1003
|
71 <h1>Registering a New Account</h1>
|
adamc@1003
|
72
|
adamc@1003
|
73 {case msg of
|
adamc@1003
|
74 None => <xml/>
|
adamc@1003
|
75 | Some msg => <xml><div>{[msg]}</div></xml>}
|
adamc@1003
|
76
|
adamc@1003
|
77 <form><table>
|
adamc@1003
|
78 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
|
adamc@1003
|
79 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
|
adamc@1003
|
80 <tr> <th><submit action={doRegister}/></th> </tr>
|
adamc@1003
|
81 </table></form>
|
adamc@1003
|
82 </body></xml>
|
adamc@1003
|
83
|
adamc@1003
|
84 and main () =
|
adamc@1004
|
85 me <- checkLogin;
|
adamc@1003
|
86 return <xml><body>
|
adamc@1003
|
87 {case me of
|
adamc@1003
|
88 None => <xml><li><a link={register None}>Register for access</a></li></xml>
|
adamc@1004
|
89 | Some me => <xml>
|
adamc@1004
|
90 <div>Welcome, {[me.Nam]}!</div>
|
adamc@1004
|
91
|
adamc@1004
|
92 {if me.Chair then
|
adamc@1004
|
93 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
|
adamc@1004
|
94 else
|
adamc@1004
|
95 <xml/>}
|
adamc@1004
|
96 </xml>}
|
adamc@1003
|
97 </body></xml>
|
adamc@1001
|
98
|
adamc@1001
|
99 end
|