3 * Stefano Zacchiroli <zack@cs.unibo.it>
4 * for the HELM Team http://helm.cs.unibo.it/
6 * This file is part of HELM, an Hypertextual, Electronic
7 * Library of Mathematics, developed at the Computer Science
8 * Department, University of Bologna, Italy.
10 * HELM is free software; you can redistribute it and/or
11 * modify it under the terms of the GNU General Public License
12 * as published by the Free Software Foundation; either version 2
13 * of the License, or (at your option) any later version.
15 * HELM is distributed in the hope that it will be useful,
16 * but WITHOUT ANY WARRANTY; without even the implied warranty of
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 * GNU General Public License for more details.
20 * You should have received a copy of the GNU General Public License
21 * along with HELM; if not, write to the Free Software
22 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
25 * For details, see the HELM World-Wide-Web page,
26 * http://helm.cs.unibo.it/
33 exception Client_already_in of client_id;;
34 exception Client_not_found of client_id;;
35 exception Musing_already_in of musing_id;;
36 exception Musing_not_found of musing_id;;
37 exception Tutor_already_in of tutor_id;;
38 exception Tutor_not_found of tutor_id;;
46 let expire_time = 1800. (* 30 minutes *)
51 inherit ThreadSafe.threadSafe
53 val timetable: (client_id, float) Hashtbl.t = Hashtbl.create 17
54 val urls: (client_id, string) Hashtbl.t = Hashtbl.create 17
55 val subscriptions: (client_id, tutor_id list) Hashtbl.t = Hashtbl.create 17
57 (** INVARIANT: each client registered has an entry in 'urls' hash table
58 _and_ in 'subscriptions hash table even if it hasn't yet invoked
61 method register id url = self#doWriter (lazy (
62 if Hashtbl.mem urls id then
63 raise (Client_already_in id)
65 Hashtbl.add urls id url;
66 Hashtbl.add subscriptions id [];
67 Hashtbl.add timetable id (Unix.time ())
70 method private remove id =
71 Hashtbl.remove urls id;
72 Hashtbl.remove subscriptions id;
73 Hashtbl.remove timetable id
74 method unregister id = self#doWriter (lazy (
75 if Hashtbl.mem urls id then
78 raise (Client_not_found id)
80 method isAuthenticated id = self#doReader (lazy (
83 method subscribe client_id tutor_ids = self#doWriter (lazy (
84 if Hashtbl.mem urls client_id then
85 Hashtbl.replace subscriptions client_id tutor_ids
87 raise (Client_not_found client_id)
89 method getUrl id = self#doReader (lazy (
90 if Hashtbl.mem urls id then
93 raise (Client_not_found id)
95 method getSubscription id = self#doReader (lazy (
96 if Hashtbl.mem urls id then
97 Hashtbl.find subscriptions id
99 raise (Client_not_found id)
102 method dump = self#doReader (lazy (
107 (sprintf "<client id=\"%s\" url=\"%s\">\n" id url) ^
108 "<subscriptions>\n" ^
109 (String.concat "\n" (* id's subscriptions *)
111 (fun tutor_id -> sprintf "<tutor id=\"%s\" />\n" tutor_id)
112 (Hashtbl.find subscriptions id))) ^
113 "</subscriptions>\n</client>\n"))
117 method purge = self#doWriter (lazy (
118 let now = Unix.time () in
121 if now -. birthday > expire_time then
131 inherit ThreadSafe.threadSafe
133 val timetable: (tutor_id, float) Hashtbl.t = Hashtbl.create 17
134 val tbl: (tutor_id, string * hint_type * string) Hashtbl.t =
137 method register id url hint_type dsc = self#doWriter (lazy (
138 if Hashtbl.mem tbl id then
139 raise (Tutor_already_in id)
141 Hashtbl.add tbl id (url, hint_type, dsc);
142 Hashtbl.add timetable id (Unix.time ())
145 method private remove id =
146 Hashtbl.remove tbl id;
147 Hashtbl.remove timetable id
148 method unregister id = self#doWriter (lazy (
149 if Hashtbl.mem tbl id then
152 raise (Tutor_not_found id)
154 method isAuthenticated id = self#doReader (lazy (
157 method exists id = self#doReader (lazy (
160 method getTutor id = self#doReader (lazy (
161 if Hashtbl.mem tbl id then
164 raise (Tutor_not_found id)
167 let (url, _, _) = self#getTutor id in
169 method getHintType id =
170 let (_, hint_type, _) = self#getTutor id in
172 method getDescription id =
173 let (_, _, dsc) = self#getTutor id in
175 method index = self#doReader (lazy (
177 (fun id (url, hint_type, dsc) idx -> (id, dsc) :: idx) tbl []
180 method dump = self#doReader (lazy (
183 (fun id (url, hint_type, dsc) dump ->
186 "<tutor id=\"%s\" url=\"%s\">\n<hint_type>%s</hint_type>\n<description>%s</description>\n</tutor>"
187 id url hint_type dsc))
191 method purge = self#doWriter (lazy (
192 let now = Unix.time () in
195 if now -. birthday > expire_time then
205 inherit ThreadSafe.threadSafe
207 val timetable: (musing_id, float) Hashtbl.t = Hashtbl.create 17
208 val musings: (musing_id, client_id * tutor_id) Hashtbl.t = Hashtbl.create 17
209 val clients: (client_id, musing_id) Hashtbl.t = Hashtbl.create 17
210 val tutors: (tutor_id, musing_id) Hashtbl.t = Hashtbl.create 17
212 (** INVARIANT: each registered musing <musing_id, client_id, tutor_id> has
213 an entry in 'musings' table, an entry in 'clients' table and an entry in
216 method register musing_id client_id tutor_id = self#doWriter (lazy (
217 if Hashtbl.mem musings musing_id then
218 raise (Musing_already_in musing_id)
220 Hashtbl.add musings musing_id (client_id, tutor_id);
221 Hashtbl.add clients client_id musing_id;
222 Hashtbl.add tutors tutor_id musing_id;
223 Hashtbl.add timetable musing_id (Unix.time ())
226 method private remove id =
227 Hashtbl.remove musings id;
228 hashtbl_remove_all clients id;
229 hashtbl_remove_all tutors id;
230 Hashtbl.remove timetable id
231 method unregister id = self#doWriter (lazy (
232 if Hashtbl.mem musings id then
235 method getByMusingId id = self#doReader (lazy (
237 Hashtbl.find musings id
238 with Not_found -> raise (Musing_not_found id)
240 method getByClientId id = self#doReader (lazy (
241 Hashtbl.find_all clients id
243 method getByTutorId id = self#doReader (lazy (
244 Hashtbl.find_all tutors id
247 method dump = self#doReader (lazy (
250 (fun mid (cid, tid) dump ->
252 (sprintf "<musing id=\"%s\" client=\"%s\" tutor=\"%s\" />\n"
257 method purge = self#doWriter (lazy (
258 let now = Unix.time () in
261 if now -. birthday > expire_time then