The R13B03 release.OTP_R13B03

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
+