- added methods

  * dump    (debugging, dump registry internal status)
  * purge   (remove ancient entries from registries)

diff --git a/helm/hbugs/broker/hbugs_broker_registry.ml b/helm/hbugs/broker/hbugs_broker_registry.ml
index 5e3baeb30aa4180bc6e0192fa7a749f07c76b7cf..644f0c53f5354bef66e988f815833449f4fad5c7 100644 (file)
--- a/helm/hbugs/broker/hbugs_broker_registry.ml
+++ b/helm/hbugs/broker/hbugs_broker_registry.ml
@@ -28,6 +28,7 @@
 
 open Hbugs_misc;;
 open Hbugs_types;;
+open Printf;;
 
 exception Client_already_in of client_id;;
 exception Client_not_found of client_id;;
@@ -36,27 +37,44 @@ exception Musing_not_found of musing_id;;
 exception Tutor_already_in of tutor_id;;
 exception Tutor_not_found of tutor_id;;
 
+class type registry =
+  object
+    method dump: string
+    method purge: unit
+  end
+
+let expire_time = 1800. (* 30 minutes *)
+
 class clients =
   object (self)
 
     inherit ThreadSafe.threadSafe
 
+    val timetable: (client_id, float) Hashtbl.t = Hashtbl.create 17
     val urls: (client_id, string) Hashtbl.t = Hashtbl.create 17
     val subscriptions: (client_id, tutor_id list) Hashtbl.t = Hashtbl.create 17
 
+      (** INVARIANT: each client registered has an entry in 'urls' hash table
+      _and_ in 'subscriptions hash table even if it hasn't yet invoked
+      'subscribe' method *)
+
     method register id url = self#doWriter (lazy (
       if Hashtbl.mem urls id then
         raise (Client_already_in id)
       else begin
         Hashtbl.add urls id url;
-        Hashtbl.add subscriptions id []
+        Hashtbl.add subscriptions id [];
+        Hashtbl.add timetable id (Unix.time ())
       end
     ))
+    method private remove id =
+      Hashtbl.remove urls id;
+      Hashtbl.remove subscriptions id;
+      Hashtbl.remove timetable id
     method unregister id = self#doWriter (lazy (
-      if Hashtbl.mem urls id then begin
-        Hashtbl.remove urls id;
-        Hashtbl.remove subscriptions id
-      end else
+      if Hashtbl.mem urls id then
+        self#remove id
+      else
         raise (Client_not_found id)
     ))
     method isAuthenticated id = self#doReader (lazy (
@@ -81,6 +99,30 @@ class clients =
         raise (Client_not_found id)
     ))
 
+    method dump = self#doReader (lazy (
+      "<clients>\n" ^
+      (Hashtbl.fold
+        (fun id url dump ->
+          (dump ^
+          (sprintf "<client id=\"%s\" url=\"%s\">\n" id url) ^
+          "<subscriptions>\n" ^
+          (String.concat "\n" (* id's subscriptions *)
+            (List.map
+              (fun tutor_id -> sprintf "<tutor id=\"%s\" />\n" tutor_id)
+              (Hashtbl.find subscriptions id))) ^
+          "</subscriptions>\n</client>\n"))
+        urls "") ^
+      "</clients>"
+    ))
+    method purge = self#doWriter (lazy (
+      let now = Unix.time () in
+      Hashtbl.iter
+        (fun id birthday ->
+          if now -. birthday > expire_time then
+            self#remove id)
+        timetable
+    ))
+
   end
 
 class tutors =
@@ -88,18 +130,24 @@ class tutors =
 
     inherit ThreadSafe.threadSafe
 
+    val timetable: (tutor_id, float) Hashtbl.t = Hashtbl.create 17
     val tbl: (tutor_id, string * hint_type * string) Hashtbl.t =
       Hashtbl.create 17
 
     method register id url hint_type dsc = self#doWriter (lazy (
       if Hashtbl.mem tbl id then
         raise (Tutor_already_in id)
-      else
-        Hashtbl.add tbl id (url, hint_type, dsc)
+      else begin
+        Hashtbl.add tbl id (url, hint_type, dsc);
+        Hashtbl.add timetable id (Unix.time ())
+      end
     ))
+    method private remove id =
+      Hashtbl.remove tbl id;
+      Hashtbl.remove timetable id
     method unregister id = self#doWriter (lazy (
       if Hashtbl.mem tbl id then
-        Hashtbl.remove tbl id
+        self#remove id
       else
         raise (Tutor_not_found id)
     ))
@@ -129,6 +177,26 @@ class tutors =
         (fun id (url, hint_type, dsc) idx -> (id, dsc) :: idx) tbl []
     ))
 
+    method dump = self#doReader (lazy (
+      "<tutors>\n" ^
+      (Hashtbl.fold
+        (fun id (url, hint_type, dsc) dump ->
+          dump ^
+          (sprintf
+"<tutor id=\"%s\" url=\"%s\">\n<hint_type>%s</hint_type>\n<description>%s</description>\n</tutor>"
+            id url hint_type dsc))
+        tbl "") ^
+      "</tutors>"
+    ))
+    method purge = self#doWriter (lazy (
+      let now = Unix.time () in
+      Hashtbl.iter
+        (fun id birthday ->
+          if now -. birthday > expire_time then
+            self#remove id)
+        timetable
+    ))
+
   end
 
 class musings =
@@ -136,25 +204,33 @@ class musings =
 
     inherit ThreadSafe.threadSafe
 
+    val timetable: (musing_id, float) Hashtbl.t = Hashtbl.create 17
     val musings: (musing_id, client_id * tutor_id) Hashtbl.t = Hashtbl.create 17
     val clients: (client_id, musing_id) Hashtbl.t = Hashtbl.create 17
     val tutors: (tutor_id, musing_id) Hashtbl.t = Hashtbl.create 17
 
+      (** INVARIANT: each registered musing <musing_id, client_id, tutor_id> has
+      an entry in 'musings' table, an entry in 'clients' table and an entry in
+      'tutors' table *)
+
     method register musing_id client_id tutor_id = self#doWriter (lazy (
       if Hashtbl.mem musings musing_id then
         raise (Musing_already_in musing_id)
       else begin
         Hashtbl.add musings musing_id (client_id, tutor_id);
         Hashtbl.add clients client_id musing_id;
-        Hashtbl.add tutors tutor_id musing_id
+        Hashtbl.add tutors tutor_id musing_id;
+        Hashtbl.add timetable musing_id (Unix.time ())
       end
     ))
+    method private remove id =
+      Hashtbl.remove musings id;
+      hashtbl_remove_all clients id;
+      hashtbl_remove_all tutors id;
+      Hashtbl.remove timetable id
     method unregister id = self#doWriter (lazy (
-      if Hashtbl.mem musings id then begin
-        Hashtbl.remove musings id;
-        hashtbl_remove_all clients id;
-        hashtbl_remove_all tutors id
-      end
+      if Hashtbl.mem musings id then
+        self#remove id
     ))
     method getByMusingId id = self#doReader (lazy (
       try
@@ -168,5 +244,24 @@ class musings =
       Hashtbl.find_all tutors id
     ))
 
+    method dump = self#doReader (lazy (
+      "<musings>\n" ^
+      (Hashtbl.fold
+        (fun mid (cid, tid) dump ->
+          dump ^
+          (sprintf "<musing id=\"%s\" client=\"%s\" tutor=\"%s\" />\n"
+            mid cid tid))
+        musings "") ^
+      "</musings>"
+    ))
+    method purge = self#doWriter (lazy (
+      let now = Unix.time () in
+      Hashtbl.iter
+        (fun id birthday ->
+          if now -. birthday > expire_time then
+            self#remove id)
+        timetable
+    ))
+
   end
 

diff --git a/helm/hbugs/broker/hbugs_broker_registry.mli b/helm/hbugs/broker/hbugs_broker_registry.mli
index 9a33f066bcb514ff89b92fb00a290d70405a354c..ad0c694e13af81c2b307f10d4b3fdc19d088f807 100644 (file)
--- a/helm/hbugs/broker/hbugs_broker_registry.mli
+++ b/helm/hbugs/broker/hbugs_broker_registry.mli
@@ -35,6 +35,12 @@ exception Musing_not_found of musing_id
 exception Tutor_already_in of tutor_id
 exception Tutor_not_found of tutor_id
 
+class type registry =
+  object
+    method dump: string
+    method purge: unit
+  end
+
 class clients:
   object
       (** 'register client_id client_url' *)
@@ -45,6 +51,9 @@ class clients:
     method subscribe: client_id -> tutor_id list -> unit
     method getUrl: client_id -> string
     method getSubscription: client_id -> tutor_id list
+
+    method dump: string
+    method purge: unit
   end
 
 class tutors:
@@ -58,6 +67,9 @@ class tutors:
     method getHintType: tutor_id -> hint_type
     method getDescription: tutor_id -> string
     method index: tutor_dsc list
+
+    method dump: string
+    method purge: unit
   end
 
 class musings:
@@ -67,5 +79,8 @@ class musings:
     method getByMusingId: musing_id -> client_id * tutor_id
     method getByClientId: client_id -> musing_id list
     method getByTutorId: tutor_id -> musing_id list
+
+    method dump: string
+    method purge: unit
   end