%% File: ims.erl
%% Indirect Messaging Server

-module(ims).
% -compile(export_all). 

%% gen_serverフレームワークを利用
-behaviour(gen_server).
-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).

%% インターフェース関数群
-export([start/0, stop/0]).
-export([register/1, register/2, bind/2, unbind/1, 
         purge/2, unregister/1, send/2]).
-export([whereis_server/0, server_name/0, registered/0, query_states/0, 
         clear_queue/1, query_state/1]).
-export([register_self/1, bind_self/1, unbind_self/1]).

%% 定数
-define(SERVER_PROC_NAME, indirect_msg_server).
-define(WAIT_FOR_TERMINATION, 100). % ミリ秒

%% デバッグ用
-define(debug, 1).
-ifdef(debug).
-define(RETURN(TokenStr, Result), ret@(TokenStr, Result)).
ret@(TokenStr, Result) ->
 io:fwrite("==>~p\n", [query_state(TokenStr)]),
 Result.
-else.
-define(RETURN(TokenStr, Result), Result).
-endif.

%% 緊急時脱出
confused(Data) ->
 error_logger:error_msg("confused: ~p", [Data]),
 exit(confused).

%%%%%% start/stop

start() -> 
 do_start(?SERVER_PROC_NAME).

% cf. gen_server:start(ServerName, Module, Args, Options) -> Result
do_start(Name) -> 
 gen_server:start({local, Name}, ?MODULE, [], []).

stop() ->
 case whereis(?SERVER_PROC_NAME) of
  undefined -> {error, not_started};
  Pid -> do_stop(Pid)
 end.

do_stop(Pid) ->
 gen_server:cast(Pid, stop),
 timer:sleep(?WAIT_FOR_TERMINATION),
 case whereis(?SERVER_PROC_NAME) of
  undefined -> ok;
  _ -> {error, cannot_stop}
 end.

%%%%%% callbacks for gen_server

init(_Args) -> {ok, no_state}.
terminate(_Reason, _State) -> ok. 
code_change(_OldVsn, State, _Extra) -> State.

%% register, bind, unbindの実質処理
do_register(TokenStr, NewPid) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    put({token, TokenStr}, {NewPid, [], false}),
    ok;
  {_Target, _Queue, _Flag} -> % 登録済み
    {error, already_registered};
  Otherwise-> confused(Otherwise)
 end.

do_bind(TokenStr, NewPid) ->
 case get({token, TokenStr}) of
  undefined -> % 未登録
    {error, not_registered};
  {_Target, _Queue, true} -> % パージされている
    {error, purged};
  Entry = {absence, _Queue, _Flag} -> % 登録済み、未束縛
    put({token, TokenStr}, setelement(1, Entry, NewPid)),
    ok;
  {_Pid, _Queue, _Flag} -> % 登録済み、束縛済み
    {error, already_bound};
  Otherwise -> confused(Otherwise)
 end.

do_unbind(TokenStr, MaybePid) ->
 case get({token, TokenStr}) of
  undefined -> % 未登録
    {error, not_registered};
  % 注意：パージされていても unbind はできる
  {absence, _Queue, _Flag} -> % 登録済み、未束縛
    {error, not_boud};
  Entry = {Pid, _Queue, _Flag} 
  when is_pid(MaybePid) -> % 登録済み、束縛済み、引数はPID
    if
      (MaybePid == Pid) -> 
        put({token, TokenStr}, setelement(1, Entry, absence)),
        ok;
      true ->
        {error, pid_not_match}
    end;
  Entry = {_Pid, _Queue, _Flag} -> % 登録済み、束縛済み
    put({token, TokenStr}, setelement(1, Entry, absence)),
    ok;
  Otherwise -> confused(Otherwise)
 end.

%%%% handle_call
%%- register/1
handle_call({register, TokenStr}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    put({token, TokenStr}, {absence, [], false}),
    RetVal = ok;
  {_Target, _Queue, _Flag} -> % 登録済み
    RetVal = {error, already_registered};
  Otherwise -> 
    RetVal = ng, % let the compiler be happy.
    confused(Otherwise)
 end,
 {reply, RetVal, State};

%%- register/2
handle_call({register, TokenStr, Pid}, _From, State) ->
 RetVal = do_register(TokenStr, Pid),
 {reply, RetVal, State};

%%- bind/2
handle_call({bind, TokenStr, Pid}, _From, State) -> 
 RetVal = do_bind(TokenStr, Pid),
 {reply, RetVal, State};

%%- unregister/1
handle_call({unregister, TokenStr}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    RetVal = {error, not_registered};
  {_Target, _Queue, _Flag} -> % 登録済み
    erase({token, TokenStr}),
    RetVal = ok;
  Otherwise -> 
    RetVal = ng, % let the compiler be happy.
    confused(Otherwise)
 end,
 {reply, RetVal, State};

%%- unbind/1
handle_call({unbind, TokenStr}, _From, State) -> 
 RetVal = do_unbind(TokenStr, dont_care),
 {reply, RetVal, State};

%%- purge/2
handle_call({purge, TokenStr, Signal}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    RetVal = {error, not_registered};
  {_Target, _Queue, true} -> % パージされている
    RetVal = {error, already_purged};
  Entry = {absence, _Queue, false} -> % 登録済み、未束縛
    put({token, TokenStr}, setelement(3, Entry, true)),
    RetVal = ok;
  Entry = {Pid, _Queue, false} -> % 登録済み、束縛済み
    put({token, TokenStr}, setelement(3, Entry, true)),
    Pid ! Signal,
    RetVal = ok;
  Otherwise -> 
    RetVal = ng, % let the compiler be happy.
    confused(Otherwise)
 end,
 {reply, RetVal, State};

%%- send/2
handle_call({send, TokenStr, Msg}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    RetVal = {error, not_registered};
  {_Target, _Queue, true} -> % パージされている
    RetVal = {error, purged};
  Entry = {absence, Queue, _Flag} -> % 登録済み、未束縛
    put({token, TokenStr}, setelement(2, Entry, [Msg|Queue])),
    RetVal = ok;
  {Pid, _Queue, _Flag} -> % 登録済み、束縛済み
    Pid ! Msg,
    RetVal = ok;
  Otherwise -> 
    RetVal = ng, % let the compiler be happy.
    confused(Otherwise)
 end,
 {reply, RetVal, State};

%%- clear_queue/1 % 要らないかな？
handle_call({clear_queue, TokenStr}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    RetVal = {error, not_registered};
  Entry = {_Target, _Queue, _Flag} -> % 登録済み
    put({token, TokenStr}, setelement(2, Entry, [])),
    RetVal = ok;
  Otherwise -> 
    RetVal = ng, % let the compiler be happy.
    confused(Otherwise)
 end,
 {reply, RetVal, State};

%%- query_state/1
handle_call({query_state, TokenStr}, _From, State) -> 
 case get({token, TokenStr}) of
  undefined -> % 未登録
    RetVal = not_registered;
  Entry = {_Target, _Queue, _Flag} -> % 登録済み
    RetVal = Entry;
  _ ->
    RetVal = {error, unknown}
 end,
 {reply, RetVal, State};

%%- registered/0
handle_call(registered, _From, State) -> 
  List = get(),
  RetVal = lists:foldl(
              fun 
               ({{token, TokenStr}, _}, Acc) -> [TokenStr|Acc]; 
               (_, Acc) -> Acc 
              end,
              [], List),
  {reply, RetVal, State};

%%- query_states/0
handle_call(query_states, _From, State) -> 
  List = get(),
  RetVal = lists:foldl(
              fun 
               ({{token, TokenStr}, Entry}, Acc) -> 
                  [{TokenStr, Entry}|Acc]; 
               (_, Acc) -> Acc 
              end,
              [], List),
  {reply, RetVal, State};

%%- register_self/1
handle_call({register_self, TokenStr}, {FromPid, _FromRef}, State) ->
 RetVal = do_register(TokenStr, FromPid),
 {reply, RetVal, State};

%%- bind_self/1
handle_call({bind_self, TokenStr}, {FromPid, _FromRef}, State) ->
 RetVal = do_bind(TokenStr, FromPid),
 {reply, RetVal, State};

%%- unbind_self/1
handle_call({unbind_self, TokenStr}, {FromPid, _FromRef}, State) ->
 RetVal = do_unbind(TokenStr, FromPid),
 {reply, RetVal, State};

%%- stop/0
handle_call(stop, _From, State) -> 
 {stop, normal, ok, State};

%% Other
handle_call(Req, _From, State) -> 
 error_logger:error_msg(
   "~w got unexpected message:~p\n", [self(), Req]),
 {reply, error, State}. % 対応が難しいね

%%%% handle_cast

%%- sotp/0
handle_cast(stop, State) -> 
 {stop, normal, State};
handle_cast(Req, State) -> 
 error_logger:error_msg(
   "~w got unexpected message:~p\n", [self(), Req]),
 {noreply, State}.

%%%% handle_info

handle_info(Req, State) -> 
 error_logger:error_msg(
   "~w got unexpected message:~p\n", [self(), Req]),
 {noreply, State}.

%%%%%% インターフェース関数

whereis_server() -> 
 whereis(?SERVER_PROC_NAME).

server_name() -> ?SERVER_PROC_NAME.

confirm_server() ->
 case whereis(?SERVER_PROC_NAME) of
  undefined -> start();
  ServerPid -> {ok, ServerPid}
 end.

register(TokenStr) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {register, TokenStr})).

register(TokenStr, Pid) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {register, TokenStr, Pid})).

unregister(TokenStr) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {unregister, TokenStr})).

bind(TokenStr, Pid) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {bind, TokenStr, Pid})).

unbind(TokenStr) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {unbind, TokenStr})).

purge(TokenStr, Signal) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {purge, TokenStr, Signal})).

send(TokenStr, Msg) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {send, TokenStr, Msg})).

clear_queue(TokenStr) ->
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {clear_queue, TokenStr})).

query_state(TokenStr) -> % ?RETURNを使ってもダメ！！
 {ok, ServerPid} = confirm_server(),
 gen_server:call(ServerPid, {query_state, TokenStr}).

registered() ->
 {ok, ServerPid} = confirm_server(),
 gen_server:call(ServerPid, registered).

query_states() ->
 {ok, ServerPid} = confirm_server(),
 gen_server:call(ServerPid, query_states).

register_self(TokenStr) -> 
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {register_self, TokenStr})).

bind_self(TokenStr) -> 
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {bind_self, TokenStr})).

unbind_self(TokenStr) -> 
 {ok, ServerPid} = confirm_server(),
 ?RETURN(TokenStr, gen_server:call(ServerPid, {unbind_self, TokenStr})).

%% The End %%