aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gs_frontend.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gs_frontend.erl')
-rw-r--r--lib/gs/src/gs_frontend.erl368
1 files changed, 368 insertions, 0 deletions
diff --git a/lib/gs/src/gs_frontend.erl b/lib/gs/src/gs_frontend.erl
new file mode 100644
index 0000000000..009b264e69
--- /dev/null
+++ b/lib/gs/src/gs_frontend.erl
@@ -0,0 +1,368 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. 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).
+
+-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
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-15 18:14:06 +0000