From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/gs/src/gs_frontend.erl | 368 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 368 insertions(+) create mode 100644 lib/gs/src/gs_frontend.erl (limited to 'lib/gs/src/gs_frontend.erl') 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 + -- cgit v1.2.3