%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
%%
%% ------------------------------------------------------------
%% Erlang Graphics Interface front-end server
%% ------------------------------------------------------------
%%
-module(gs_frontend).
-compile([{nowarn_deprecated_function,{gs,assq,2}},
{nowarn_deprecated_function,{gs,error,2}}]).
-export([create/2,
config/2,
read/2,
destroy/2,
info/1,
start/1,
stop/0,
init/1,
event/3]).
-include("gstk.hrl").
%%----------------------------------------------------------------------
%% The ets contains: {Obj,lives}|{Obj,{Name,Pid}}
%% new obj is {Int,Node}
%% {{Name,Pid},Obj}
%%----------------------------------------------------------------------
-record(state, {db,user,user_count,kernel,kernel_count,self}).
%%----------------------------------------------------------------------
%% The interface.
%%----------------------------------------------------------------------
create(GsPid,Args) ->
request(GsPid,{create,Args}).
config(GsPid,Args) ->
request(GsPid,{config, Args}).
read(GsPid,Args) ->
request(GsPid,{read, Args}).
destroy(GsPid,IdOrName) ->
request(GsPid,{destroy, IdOrName}).
info(Option) ->
request(gs_frontend,{info,Option}).
%%----------------------------------------------------------------------
%% Comment: Frontend is only locally registered. These functions are called
%% by any backend.
%%----------------------------------------------------------------------
event(FrontEnd,ToOwner,EventMsg) ->
FrontEnd ! {event, ToOwner,EventMsg}.
request(GsPid,Msg) ->
GsPid ! {self(),Msg},
receive
{gs_reply,R} -> R
end.
%%----------------------------------------------------------------------
%% The server
%%----------------------------------------------------------------------
start(Opts) ->
case whereis(gs_frontend) of
undefined ->
P = spawn_link(gs_frontend,init,[Opts]),
case catch register(gs_frontend, P) of
true ->
request(gs_frontend,{instance, backend_name(Opts), Opts});
{'EXIT', _} ->
exit(P,kill), % a raise... and I lost this time
start(Opts)
end;
P ->
request(P,{instance,backend_name(Opts),Opts})
end.
backend_name(Opts) ->
case gs:assq(kernel,Opts) of
{value,true} -> kernel;
_ -> user
end.
stop() ->
request(gs_frontend,stop).
%% ------------------------------------------------------------
%% THE FRONT END SERVER
%% ------------------------------------------------------------
%% Initialize
%%
init(_Opts) ->
process_flag(trap_exit, true),
DB=ets:new(gs_names,[set,public]),
loop(#state{db=DB,self=self()}).
loop(State) ->
receive
X ->
% io:format("frontend received: ~p~n",[X]),
case catch (doit(X,State)) of
done -> loop(State);
NewState when is_record(NewState,state) ->
loop(NewState);
stop -> stop;
Reason ->
io:format("GS frontend. Last mgs in was:~p~n",[X]),
io:format("exit:~p~n",[X]),
io:format("Reason: ~p~n", [Reason]),
terminate(Reason,State),
exit(Reason)
end
end.
reply(To,Msg) ->
To ! {gs_reply,Msg},
done.
doit({FromOwner,{config, Args}},State) ->
{IdOrName, Opts} = Args,
#state{db=DB} = State,
case idOrName_to_id(DB,IdOrName,FromOwner) of
undefined ->
reply(FromOwner,{error,{no_such_object,IdOrName}});
Obj ->
reply(FromOwner,gstk:config(backend(State,Obj),{Obj,Opts}))
end;
doit({event,ToOwner,{gs,Obj,Etype,Data,Args}}, #state{db=DB,self=Self}) ->
case ets:lookup(DB,Obj) of
[{_,{Name,ToOwner}}] -> ToOwner ! {gs,Name,Etype,Data,Args};
_ -> ToOwner ! {gs,{Obj,Self},Etype,Data,Args}
end,
done;
doit({FromOwner,{create,Args}}, State) ->
{Objtype, Name, Parent, Opts} = Args,
#state{db=DB} = State,
NameOccupied = case {Name, ets:lookup(DB,{Name,FromOwner})} of
{undefined,_} -> false;
{_, []} -> false;
_ -> true
end,
if NameOccupied == true ->
reply(FromOwner, {error,{name_occupied,Name}});
true ->
case idOrName_to_id(DB,Parent,FromOwner) of
undefined ->
reply(FromOwner, {error,{no_such_parent,Parent}});
ParentObj ->
{Id,NewState} = inc(ParentObj,State),
case gstk:create(backend(State,ParentObj),
{FromOwner,{Objtype,Id,ParentObj,Opts}}) of
ok ->
link(FromOwner),
if Name == undefined ->
ets:insert(DB,{Id,lives}),
reply(FromOwner, Id),
NewState;
true -> % it's a real name, register it
NamePid = {Name,FromOwner},
ets:insert(DB,{NamePid,Id}),
ets:insert(DB,{Id,NamePid}),
reply(FromOwner,Id),
NewState
end;
Err -> reply(FromOwner,Err)
end
end
end;
doit({FromOwner,{read, Args}}, State) ->
#state{db=DB} = State,
{IdOrName, Opt} = Args,
case idOrName_to_id(DB,IdOrName,FromOwner) of
undefined ->
reply(FromOwner,{error,{no_such_object,IdOrName}});
Obj ->
reply(FromOwner,gstk:read(backend(State,Obj),{Obj,Opt}))
end;
doit({'EXIT', UserBackend, Reason}, State)
when State#state.user == UserBackend ->
gs:error("user backend died reason ~w~n", [Reason]),
remove_user_objects(State#state.db),
State#state{user=undefined};
doit({'EXIT', KernelBackend, Reason}, State)
when State#state.kernel == KernelBackend ->
gs:error("kernel backend died reason ~w~n", [Reason]),
exit({gs_kernel_died,Reason});
doit({'EXIT', Pid, _Reason}, #state{kernel=K,user=U,db=DB}) ->
%% io:format("Pid ~w died reason ~w~n", [Pid, _Reason]),
if is_pid(U) ->
DeadObjU = gstk:pid_died(U,Pid),
remove_objs(DB,DeadObjU);
true -> ok
end,
if is_pid(K) ->
DeadObjK = gstk:pid_died(K,Pid),
remove_objs(DB,DeadObjK);
true -> true end,
done;
doit({FromOwner,{destroy, IdOrName}}, State) ->
#state{db=DB} = State,
case idOrName_to_id(DB,IdOrName,FromOwner) of
undefined ->
reply(FromOwner, {error,{no_such_object,IdOrName}});
Obj ->
DeadObj = gstk:destroy(backend(State,Obj),Obj),
remove_objs(DB,DeadObj),
reply(FromOwner,done)
end;
doit({From,{instance,user,Opts}},State) ->
#state{db=DB, self=Self, user_count=UC} = State,
case ets:lookup(DB,1) of
[_] -> reply(From, {1,Self});
[] ->
ets:insert(DB,{1,lives}), % parent of all user gs objs
case gstk:start_link(1, Self, Self, Opts) of
{ok, UserBackend} ->
reply(From, {1, Self}),
case UC of
undefined ->
State#state{user_count=1, user=UserBackend};
_N ->
State#state{user_count=UC+2, user=UserBackend}
end;
{error, Reason} ->
reply(From, {error, Reason}),
stop
end
end;
doit({From,{instance,kernel,Opts}},State) ->
#state{db=DB,self=Self} = State,
case ets:lookup(DB,0) of
[_] -> reply(From, {0,Self});
[] ->
ets:insert(DB,{0,lives}), % parent of all user gs objs
case gstk:start_link(0,Self,Self,Opts) of
{ok, KernelBackend} ->
reply(From, {0,Self}),
State#state{kernel_count=0,kernel=KernelBackend};
{error, Reason} ->
reply(From, {error,Reason}),
stop
end
end;
doit({From,stop}, State) ->
#state{kernel=K,user=U} = State,
if is_pid(U) -> gstk:stop(U);
true -> true end,
if is_pid(K) -> gstk:stop(K);
true -> true end,
reply(From,stopped),
stop;
doit({From,{gstk,user,Msg}},State) ->
reply(From,gstk:request(State#state.user,Msg));
doit({From,{gstk,kernel,Msg}},State) ->
reply(From,gstk:request(State#state.kernel,Msg));
doit({From,{info,gs_db}},State) ->
io:format("gs_db:~p~n",[ets:tab2list(State#state.db)]),
reply(From,State);
doit({From,{info,kernel_db}},State) ->
reply(From,gstk:request(State#state.kernel,dump_db));
doit({From,{info,user_db}},State) ->
reply(From,gstk:request(State#state.user,dump_db));
doit({From,{info,Unknown}},_State) ->
io:format("gs: unknown info option '~w', use one of 'gs_db', 'kernel_db' or 'user_db'~n",[Unknown]),
reply(From,ok).
terminate(_Reason,#state{db=DB}) ->
if DB==undefined -> ok;
true ->
% io:format("frontend db:~p~n",[ets:tab2list(DB)])
ok
end.
backend(#state{user=Upid,kernel=Kpid},Obj) ->
if Obj rem 2 == 0 -> Kpid;
true -> Upid
end.
%%----------------------------------------------------------------------
%% Returns: {NewId,NewState}
%%----------------------------------------------------------------------
inc(ParInt,State) when ParInt rem 2 == 1 ->
X=State#state.user_count+2,
{X,State#state{user_count=X}};
inc(ParInt,State) when ParInt rem 2 == 0 ->
X=State#state.kernel_count+2,
{X,State#state{kernel_count=X}}.
remove_user_objects(DB) ->
DeadObj = find_user_obj(ets:first(DB),DB),
remove_objs(DB,DeadObj).
find_user_obj(Int,DB) when is_integer(Int) ->
if Int rem 2 == 0 -> %% a kernel obj
find_user_obj(ets:next(DB,Int),DB);
true -> %% a user obj
[Int|find_user_obj(ets:next(DB,Int),DB)]
end;
find_user_obj('$end_of_table',_DB) ->
[];
find_user_obj(OtherKey,DB) ->
find_user_obj(ets:next(DB,OtherKey),DB).
remove_objs(DB,[Obj|Objs]) ->
case ets:lookup(DB, Obj) of
[{_,NamePid}] ->
ets:delete(DB,Obj),
ets:delete(DB,NamePid);
[] -> backend_only
end,
remove_objs(DB,Objs);
remove_objs(_DB,[]) -> done.
idOrName_to_id(DB,IdOrName,Pid) when is_atom(IdOrName) ->
case ets:lookup(DB,{IdOrName,Pid}) of
[{_,Obj}] -> Obj;
_ -> undefined
end;
idOrName_to_id(DB,Obj,_Pid) ->
case ets:lookup(DB,Obj) of
[_] -> Obj;
_ -> undefined
end.
%% ----------------------------------------
%% done
