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"
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 *)
~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
))