]> matita.cs.unibo.it Git - helm.git/commitdiff
Support for optional state (empty XML element).
authorClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Wed, 16 Apr 2003 14:11:28 +0000 (14:11 +0000)
committerClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Wed, 16 Apr 2003 14:11:28 +0000 (14:11 +0000)
helm/hbugs/broker/hbugs_broker.ml

index 495fbf161084402f533e59faa3c9f88b702558a0..2ff8b98349dbf11853fbff1b676b706195b7c0df 100644 (file)
@@ -53,7 +53,9 @@ let return_xml_msg body outchan =
   Http_daemon.respond ~headers:["Content-Type", "text/xml"] ~body outchan
 ;;
 let parse_musing_id = function
-  | Musing_started (_, musing_id) -> musing_id
+  | Musing_started (_, musing_id) ->
+       prerr_endline ("#### Started musing ID: " ^ musing_id);
+       musing_id
   | Musing_aborted (_, musing_id) -> musing_id
   | msg ->
       prerr_endline (sprintf "Assertion failed, received msg: %s"
@@ -146,6 +148,7 @@ let handle_msg outchan msg =
         prerr_endline (sprintf "ACTIVE MUSINGS: %s" (String.concat ", " active_musings));
         if List.length active_musings = 0 then
           prerr_endline ("No active musings for client " ^ client_id);
+        prerr_endline "CSC: State change!!!" ;
         let stop_answers =
           List.map  (* collect Abort_musing message's responses *)
             (fun id ->  (* musing id *)
@@ -154,27 +157,33 @@ let handle_msg outchan msg =
                 ~url:(tutors#getUrl tutor) (Abort_musing (my_own_id, id)))
             active_musings
         in
+                               let stopped_musing_ids = List.map parse_musing_id stop_answers in
         List.iter musings#unregister active_musings;
-        let subscriptions = clients#getSubscription client_id in
-        if List.length subscriptions = 0 then
-          prerr_endline ("No subscriptions for client " ^ client_id);
-        let started_musing_ids =
-          List.map  (* register new musings and collect their ids *)
-            (fun tutor_id ->
-              let res =
-                Hbugs_messages.submit_req
-                  ~url:(tutors#getUrl tutor_id)
-                  (Start_musing (my_own_id, new_state))
-              in
-              let musing_id = parse_musing_id res in
-              musings#register musing_id client_id tutor_id;
-              musing_id)
-            subscriptions
-        in
-        let stopped_musing_ids = List.map parse_musing_id stop_answers in
-        Hbugs_messages.respond_msg
-          (State_accepted (my_own_id, stopped_musing_ids, started_musing_ids))
-          outchan
+                               (match new_state with
+                               | Some new_state ->     (* need to start new musings *)
+                                       let subscriptions = clients#getSubscription client_id in
+                                       if List.length subscriptions = 0 then
+                                               prerr_endline ("No subscriptions for client " ^ client_id);
+                                       let started_musing_ids =
+                                               List.map  (* register new musings and collect their ids *)
+                                                       (fun tutor_id ->
+                                                               let res =
+                                                                       Hbugs_messages.submit_req
+                                                                               ~url:(tutors#getUrl tutor_id)
+                                                                               (Start_musing (my_own_id, new_state))
+                                                               in
+                                                               let musing_id = parse_musing_id res in
+                                                               musings#register musing_id client_id tutor_id;
+                                                               musing_id)
+                                                       subscriptions
+                                       in
+                                       Hbugs_messages.respond_msg
+                                               (State_accepted (my_own_id, stopped_musing_ids, started_musing_ids))
+                                               outchan
+                               | None ->       (* no need to start new musings *)
+                                               Hbugs_messages.respond_msg
+                                                       (State_accepted (my_own_id, stopped_musing_ids, []))
+                                                       outchan)
       end else
         Hbugs_messages.respond_exc "forbidden" client_id outchan
     ))