%% This file is a copy of gen_server.erl from the R11B-5 Erlang/OTP

 %% distribution, with the following modifications:

 %%

 %% 1) the module name is gen_server2

 %%

 %% 2) more efficient handling of selective receives in callbacks

 %% gen_server2 processes drain their message queue into an internal

 %% buffer before invoking any callback module functions. Messages are

 %% dequeued from the buffer for processing. Thus the effective message

 %% queue of a gen_server2 process is the concatenation of the internal

 %% buffer and the real message queue.

 %% As a result of the draining, any selective receive invoked inside a

 %% callback is less likely to have to scan a large message queue.

 %%

 %% 3) gen_server2:cast is guaranteed to be order-preserving

 %% The original code could reorder messages when communicating with a

 %% process on a remote node that was not currently connected.

 %%

 %% All modifications are (C) 2009 LShift Ltd.

 %% ``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 via the world wide web 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.

 %% 

 %% The Initial Developer of the Original Code is Ericsson Utvecklings AB.

 %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings

 %% AB. All Rights Reserved.''

 %% 

 %%     $Id$

 %%

 -module(gen_server2).

 %%% ---------------------------------------------------

 %%%

 %%% The idea behind THIS server is that the user module

 %%% provides (different) functions to handle different

 %%% kind of inputs. 

 %%% If the Parent process terminates the Module:terminate/2

 %%% function is called.

 %%%

 %%% The user module should export:

 %%%

 %%%   init(Args)  

 %%%     ==> {ok, State}

 %%%         {ok, State, Timeout}

 %%%         ignore

 %%%         {stop, Reason}

 %%%

 %%%   handle_call(Msg, {From, Tag}, State)

 %%%

 %%%    ==> {reply, Reply, State}

 %%%        {reply, Reply, State, Timeout}

 %%%        {noreply, State}

 %%%        {noreply, State, Timeout}

 %%%        {stop, Reason, Reply, State}  

 %%%              Reason = normal | shutdown | Term terminate(State) is called

 %%%

 %%%   handle_cast(Msg, State)

 %%%

 %%%    ==> {noreply, State}

 %%%        {noreply, State, Timeout}

 %%%        {stop, Reason, State} 

 %%%              Reason = normal | shutdown | Term terminate(State) is called

 %%%

 %%%   handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ...

 %%%

 %%%    ==> {noreply, State}

 %%%        {noreply, State, Timeout}

 %%%        {stop, Reason, State} 

 %%%              Reason = normal | shutdown | Term, terminate(State) is called

 %%%

 %%%   terminate(Reason, State) Let the user module clean up

 %%%        always called when server terminates

 %%%

 %%%    ==> ok

 %%%

 %%%

 %%% The work flow (of the server) can be described as follows:

 %%%

 %%%   User module                          Generic

 %%%   -----------                          -------

 %%%     start            ----->             start

 %%%     init             <-----              .

 %%%

 %%%                                         loop

 %%%     handle_call      <-----              .

 %%%                      ----->             reply

 %%%

 %%%     handle_cast      <-----              .

 %%%

 %%%     handle_info      <-----              .

 %%%

 %%%     terminate        <-----              .

 %%%

 %%%                      ----->             reply

 %%%

 %%%

 %%% ---------------------------------------------------

 %% API

 -export([start/3, start/4,

 	 start_link/3, start_link/4,

 	 call/2, call/3,

 	 cast/2, reply/2,

 	 abcast/2, abcast/3,

 	 multi_call/2, multi_call/3, multi_call/4,

 	 enter_loop/3, enter_loop/4, enter_loop/5]).

 -export([behaviour_info/1]).

 %% System exports

 -export([system_continue/3,

 	 system_terminate/4,

 	 system_code_change/4,

 	 format_status/2]).

 %% Internal exports

 -export([init_it/6, print_event/3]).

 -import(error_logger, [format/2]).

 %%%=========================================================================

 %%%  API

 %%%=========================================================================

 behaviour_info(callbacks) ->

     [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},

      {terminate,2},{code_change,3}];

 behaviour_info(_Other) ->

     undefined.

 %%%  -----------------------------------------------------------------

 %%% Starts a generic server.

 %%% start(Mod, Args, Options)

 %%% start(Name, Mod, Args, Options)

 %%% start_link(Mod, Args, Options)

 %%% start_link(Name, Mod, Args, Options) where:

 %%%    Name ::= {local, atom()} | {global, atom()}

 %%%    Mod  ::= atom(), callback module implementing the 'real' server

 %%%    Args ::= term(), init arguments (to Mod:init/1)

 %%%    Options ::= [{timeout, Timeout} | {debug, [Flag]}]

 %%%      Flag ::= trace | log | {logfile, File} | statistics | debug

 %%%          (debug == log && statistics)

 %%% Returns: {ok, Pid} |

 %%%          {error, {already_started, Pid}} |

 %%%          {error, Reason}

 %%% -----------------------------------------------------------------

 start(Mod, Args, Options) ->

     gen:start(?MODULE, nolink, Mod, Args, Options).

 start(Name, Mod, Args, Options) ->

     gen:start(?MODULE, nolink, Name, Mod, Args, Options).

 start_link(Mod, Args, Options) ->

     gen:start(?MODULE, link, Mod, Args, Options).

 start_link(Name, Mod, Args, Options) ->

     gen:start(?MODULE, link, Name, Mod, Args, Options).

 %% -----------------------------------------------------------------

 %% Make a call to a generic server.

 %% If the server is located at another node, that node will

 %% be monitored.

 %% If the client is trapping exits and is linked server termination

 %% is handled here (? Shall we do that here (or rely on timeouts) ?).

 %% ----------------------------------------------------------------- 

 call(Name, Request) ->

     case catch gen:call(Name, '$gen_call', Request) of

 	{ok,Res} ->

 	    Res;

 	{'EXIT',Reason} ->

 	    exit({Reason, {?MODULE, call, [Name, Request]}})

     end.

 call(Name, Request, Timeout) ->

     case catch gen:call(Name, '$gen_call', Request, Timeout) of

 	{ok,Res} ->

 	    Res;

 	{'EXIT',Reason} ->

 	    exit({Reason, {?MODULE, call, [Name, Request, Timeout]}})

     end.

 %% -----------------------------------------------------------------

 %% Make a cast to a generic server.

 %% -----------------------------------------------------------------

 cast({global,Name}, Request) ->

     catch global:send(Name, cast_msg(Request)),

     ok;

 cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> 

     do_cast(Dest, Request);

 cast(Dest, Request) when is_atom(Dest) ->

     do_cast(Dest, Request);

 cast(Dest, Request) when is_pid(Dest) ->

     do_cast(Dest, Request).

 do_cast(Dest, Request) -> 

     do_send(Dest, cast_msg(Request)),

     ok.

 cast_msg(Request) -> {'$gen_cast',Request}.

 %% -----------------------------------------------------------------

 %% Send a reply to the client.

 %% -----------------------------------------------------------------

 reply({To, Tag}, Reply) ->

     catch To ! {Tag, Reply}.

 %% ----------------------------------------------------------------- 

 %% Asyncronous broadcast, returns nothing, it's just send'n prey

 %%-----------------------------------------------------------------  

 abcast(Name, Request) when is_atom(Name) ->

     do_abcast([node() | nodes()], Name, cast_msg(Request)).

 abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) ->

     do_abcast(Nodes, Name, cast_msg(Request)).

 do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) ->

     do_send({Name,Node},Msg),

     do_abcast(Nodes, Name, Msg);

 do_abcast([], _,_) -> abcast.

 %%% -----------------------------------------------------------------

 %%% Make a call to servers at several nodes.

 %%% Returns: {[Replies],[BadNodes]}

 %%% A Timeout can be given

 %%% 

 %%% A middleman process is used in case late answers arrives after

 %%% the timeout. If they would be allowed to glog the callers message

 %%% queue, it would probably become confused. Late answers will 

 %%% now arrive to the terminated middleman and so be discarded.

 %%% -----------------------------------------------------------------

 multi_call(Name, Req)

   when is_atom(Name) ->

     do_multi_call([node() | nodes()], Name, Req, infinity).

 multi_call(Nodes, Name, Req) 

   when is_list(Nodes), is_atom(Name) ->

     do_multi_call(Nodes, Name, Req, infinity).

 multi_call(Nodes, Name, Req, infinity) ->

     do_multi_call(Nodes, Name, Req, infinity);

 multi_call(Nodes, Name, Req, Timeout) 

   when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 ->

     do_multi_call(Nodes, Name, Req, Timeout).

 %%-----------------------------------------------------------------

 %% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>) ->_ 

 %%   

 %% Description: Makes an existing process into a gen_server. 

 %%              The calling process will enter the gen_server receive 

 %%              loop and become a gen_server process.

 %%              The process *must* have been started using one of the 

 %%              start functions in proc_lib, see proc_lib(3). 

 %%              The user is responsible for any initialization of the 

 %%              process, including registering a name for it.

 %%-----------------------------------------------------------------

 enter_loop(Mod, Options, State) ->

     enter_loop(Mod, Options, State, self(), infinity).

 enter_loop(Mod, Options, State, ServerName = {_, _}) ->

     enter_loop(Mod, Options, State, ServerName, infinity);

 enter_loop(Mod, Options, State, Timeout) ->

     enter_loop(Mod, Options, State, self(), Timeout).

 enter_loop(Mod, Options, State, ServerName, Timeout) ->

     Name = get_proc_name(ServerName),

     Parent = get_parent(),

     Debug = debug_options(Name, Options),

     Queue = queue:new(),

     loop(Parent, Name, State, Mod, Timeout, Queue, Debug).

 %%%========================================================================

 %%% Gen-callback functions

 %%%========================================================================

 %%% ---------------------------------------------------

 %%% Initiate the new process.

 %%% Register the name using the Rfunc function

 %%% Calls the Mod:init/Args function.

 %%% Finally an acknowledge is sent to Parent and the main

 %%% loop is entered.

 %%% ---------------------------------------------------

 init_it(Starter, self, Name, Mod, Args, Options) ->

     init_it(Starter, self(), Name, Mod, Args, Options);

 init_it(Starter, Parent, Name, Mod, Args, Options) ->

     Debug = debug_options(Name, Options),

     Queue = queue:new(),

     case catch Mod:init(Args) of

 	{ok, State} ->

 	    proc_lib:init_ack(Starter, {ok, self()}), 	    

 	    loop(Parent, Name, State, Mod, infinity, Queue, Debug);

 	{ok, State, Timeout} ->

 	    proc_lib:init_ack(Starter, {ok, self()}), 	    

 	    loop(Parent, Name, State, Mod, Timeout, Queue, Debug);

 	{stop, Reason} ->

 	    proc_lib:init_ack(Starter, {error, Reason}),

 	    exit(Reason);

 	ignore ->

 	    proc_lib:init_ack(Starter, ignore),

 	    exit(normal);

 	{'EXIT', Reason} ->

 	    proc_lib:init_ack(Starter, {error, Reason}),

 	    exit(Reason);

 	Else ->

 	    Error = {bad_return_value, Else},

 	    proc_lib:init_ack(Starter, {error, Error}),

 	    exit(Error)

     end.

 %%%========================================================================

 %%% Internal functions

 %%%========================================================================

 %%% ---------------------------------------------------

 %%% The MAIN loop.

 %%% ---------------------------------------------------

 loop(Parent, Name, State, Mod, Time, Queue, Debug) ->

     receive

         Input -> loop(Parent, Name, State, Mod,

                       Time, queue:in(Input, Queue), Debug)

     after 0 ->

             case queue:out(Queue) of

                 {{value, Msg}, Queue1} ->

                     process_msg(Parent, Name, State, Mod,

                                 Time, Queue1, Debug, Msg);

                 {empty, Queue1} ->

                     receive

                         Input ->

                             loop(Parent, Name, State, Mod,

                                  Time, queue:in(Input, Queue1), Debug)

                     after Time ->

                             process_msg(Parent, Name, State, Mod,

                                         Time, Queue1, Debug, timeout)

                     end

             end

     end.

 process_msg(Parent, Name, State, Mod, Time, Queue, Debug, Msg) ->

     case Msg of

 	{system, From, Req} ->

 	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,

 				  [Name, State, Mod, Time, Queue]);

 	{'EXIT', Parent, Reason} ->

 	    terminate(Reason, Name, Msg, Mod, State, Debug);

 	_Msg when Debug =:= [] ->

 	    handle_msg(Msg, Parent, Name, State, Mod, Time, Queue);

 	_Msg ->

 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, 

 				      Name, {in, Msg}),

 	    handle_msg(Msg, Parent, Name, State, Mod, Time, Queue, Debug1)

     end.

 %%% ---------------------------------------------------

 %%% Send/recive functions

 %%% ---------------------------------------------------

 do_send(Dest, Msg) ->

     catch erlang:send(Dest, Msg).

 do_multi_call(Nodes, Name, Req, infinity) ->

     Tag = make_ref(),

     Monitors = send_nodes(Nodes, Name, Tag, Req),

     rec_nodes(Tag, Monitors, Name, undefined);

 do_multi_call(Nodes, Name, Req, Timeout) ->

     Tag = make_ref(),

     Caller = self(),

     Receiver =

 	spawn(

 	  fun() ->

 		  %% Middleman process. Should be unsensitive to regular

 		  %% exit signals. The sychronization is needed in case

 		  %% the receiver would exit before the caller started

 		  %% the monitor.

 		  process_flag(trap_exit, true),

 		  Mref = erlang:monitor(process, Caller),

 		  receive

 		      {Caller,Tag} ->

 			  Monitors = send_nodes(Nodes, Name, Tag, Req),

 			  TimerId = erlang:start_timer(Timeout, self(), ok),

 			  Result = rec_nodes(Tag, Monitors, Name, TimerId),

 			  exit({self(),Tag,Result});

 		      {'DOWN',Mref,_,_,_} ->

 			  %% Caller died before sending us the go-ahead.

 			  %% Give up silently.

 			  exit(normal)

 		  end

 	  end),

     Mref = erlang:monitor(process, Receiver),

     Receiver ! {self(),Tag},

     receive

 	{'DOWN',Mref,_,_,{Receiver,Tag,Result}} ->

 	    Result;

 	{'DOWN',Mref,_,_,Reason} ->

 	    %% The middleman code failed. Or someone did 

 	    %% exit(_, kill) on the middleman process => Reason==killed

 	    exit(Reason)

     end.

 send_nodes(Nodes, Name, Tag, Req) ->

     send_nodes(Nodes, Name, Tag, Req, []).

 send_nodes([Node|Tail], Name, Tag, Req, Monitors)

   when is_atom(Node) ->

     Monitor = start_monitor(Node, Name),

     %% Handle non-existing names in rec_nodes.

     catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req},

     send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]);

 send_nodes([_Node|Tail], Name, Tag, Req, Monitors) ->

     %% Skip non-atom Node

     send_nodes(Tail, Name, Tag, Req, Monitors);

 send_nodes([], _Name, _Tag, _Req, Monitors) -> 

     Monitors.

 %% Against old nodes:

 %% If no reply has been delivered within 2 secs. (per node) check that

 %% the server really exists and wait for ever for the answer.

 %%

 %% Against contemporary nodes:

 %% Wait for reply, server 'DOWN', or timeout from TimerId.

 rec_nodes(Tag, Nodes, Name, TimerId) -> 

     rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId).

 rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) ->

     receive

 	{'DOWN', R, _, _, _} ->

 	    rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId);

 	{{Tag, N}, Reply} ->  %% Tag is bound !!!

 	    unmonitor(R), 

 	    rec_nodes(Tag, Tail, Name, Badnodes, 

 		      [{N,Reply}|Replies], Time, TimerId);

 	{timeout, TimerId, _} ->	

 	    unmonitor(R),

 	    %% Collect all replies that already have arrived

 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)

     end;

 rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) ->

     %% R6 node

     receive

 	{nodedown, N} ->

 	    monitor_node(N, false),

 	    rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId);

 	{{Tag, N}, Reply} ->  %% Tag is bound !!!

 	    receive {nodedown, N} -> ok after 0 -> ok end,

 	    monitor_node(N, false),

 	    rec_nodes(Tag, Tail, Name, Badnodes,

 		      [{N,Reply}|Replies], 2000, TimerId);

 	{timeout, TimerId, _} ->	

 	    receive {nodedown, N} -> ok after 0 -> ok end,

 	    monitor_node(N, false),

 	    %% Collect all replies that already have arrived

 	    rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies)

     after Time ->

 	    case rpc:call(N, erlang, whereis, [Name]) of

 		Pid when is_pid(Pid) -> % It exists try again.

 		    rec_nodes(Tag, [N|Tail], Name, Badnodes,

 			      Replies, infinity, TimerId);

 		_ -> % badnode

 		    receive {nodedown, N} -> ok after 0 -> ok end,

 		    monitor_node(N, false),

 		    rec_nodes(Tag, Tail, Name, [N|Badnodes],

 			      Replies, 2000, TimerId)

 	    end

     end;

 rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) ->

     case catch erlang:cancel_timer(TimerId) of

 	false ->  % It has already sent it's message

 	    receive

 		{timeout, TimerId, _} -> ok

 	    after 0 ->

 		    ok

 	    end;

 	_ -> % Timer was cancelled, or TimerId was 'undefined'

 	    ok

     end,

     {Replies, Badnodes}.

 %% Collect all replies that already have arrived

 rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) ->

     receive

 	{'DOWN', R, _, _, _} ->

 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);

 	{{Tag, N}, Reply} -> %% Tag is bound !!!

 	    unmonitor(R),

 	    rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])

     after 0 ->

 	    unmonitor(R),

 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)

     end;

 rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) ->

     %% R6 node

     receive

 	{nodedown, N} ->

 	    monitor_node(N, false),

 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies);

 	{{Tag, N}, Reply} ->  %% Tag is bound !!!

 	    receive {nodedown, N} -> ok after 0 -> ok end,

 	    monitor_node(N, false),

 	    rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies])

     after 0 ->

 	    receive {nodedown, N} -> ok after 0 -> ok end,

 	    monitor_node(N, false),

 	    rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies)

     end;

 rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) ->

     {Replies, Badnodes}.

 %%% ---------------------------------------------------

 %%% Monitor functions

 %%% ---------------------------------------------------

 start_monitor(Node, Name) when is_atom(Node), is_atom(Name) ->

     if node() =:= nonode@nohost, Node =/= nonode@nohost ->

 	    Ref = make_ref(),

 	    self() ! {'DOWN', Ref, process, {Name, Node}, noconnection},

 	    {Node, Ref};

        true ->

 	    case catch erlang:monitor(process, {Name, Node}) of

 		{'EXIT', _} ->

 		    %% Remote node is R6

 		    monitor_node(Node, true),

 		    Node;

 		Ref when is_reference(Ref) ->

 		    {Node, Ref}

 	    end

     end.

 %% Cancels a monitor started with Ref=erlang:monitor(_, _).

 unmonitor(Ref) when is_reference(Ref) ->

     erlang:demonitor(Ref),

     receive

 	{'DOWN', Ref, _, _, _} ->

 	    true

     after 0 ->

 	    true

     end.

 %%% ---------------------------------------------------

 %%% Message handling functions

 %%% ---------------------------------------------------

 dispatch({'$gen_cast', Msg}, Mod, State) ->

     Mod:handle_cast(Msg, State);

 dispatch(Info, Mod, State) ->

     Mod:handle_info(Info, State).

 handle_msg({'$gen_call', From, Msg},

            Parent, Name, State, Mod, _Time, Queue) ->

     case catch Mod:handle_call(Msg, From, State) of

 	{reply, Reply, NState} ->

 	    reply(From, Reply),

 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);

 	{reply, Reply, NState, Time1} ->

 	    reply(From, Reply),

 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);

 	{noreply, NState} ->

 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);

 	{noreply, NState, Time1} ->

 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);

 	{stop, Reason, Reply, NState} ->

 	    {'EXIT', R} = 

 		(catch terminate(Reason, Name, Msg, Mod, NState, [])),

 	    reply(From, Reply),

 	    exit(R);

 	Other -> handle_common_reply(Other,

                                      Parent, Name, Msg, Mod, State, Queue)

     end;

 handle_msg(Msg,

            Parent, Name, State, Mod, _Time, Queue) ->

     Reply = (catch dispatch(Msg, Mod, State)),

     handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue).

 handle_msg({'$gen_call', From, Msg},

            Parent, Name, State, Mod, _Time, Queue, Debug) ->

     case catch Mod:handle_call(Msg, From, State) of

 	{reply, Reply, NState} ->

 	    Debug1 = reply(Name, From, Reply, NState, Debug),

 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);

 	{reply, Reply, NState, Time1} ->

 	    Debug1 = reply(Name, From, Reply, NState, Debug),

 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);

 	{noreply, NState} ->

 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,

 				      {noreply, NState}),

 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);

 	{noreply, NState, Time1} ->

 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,

 				      {noreply, NState}),

 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);

 	{stop, Reason, Reply, NState} ->

 	    {'EXIT', R} = 

 		(catch terminate(Reason, Name, Msg, Mod, NState, Debug)),

 	    reply(Name, From, Reply, NState, Debug),

 	    exit(R);

 	Other ->

 	    handle_common_reply(Other,

                                 Parent, Name, Msg, Mod, State, Queue, Debug)

     end;

 handle_msg(Msg,

            Parent, Name, State, Mod, _Time, Queue, Debug) ->

     Reply = (catch dispatch(Msg, Mod, State)),

     handle_common_reply(Reply,

                         Parent, Name, Msg, Mod, State, Queue, Debug).

 handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue) ->

     case Reply of

 	{noreply, NState} ->

 	    loop(Parent, Name, NState, Mod, infinity, Queue, []);

 	{noreply, NState, Time1} ->

 	    loop(Parent, Name, NState, Mod, Time1, Queue, []);

 	{stop, Reason, NState} ->

 	    terminate(Reason, Name, Msg, Mod, NState, []);

 	{'EXIT', What} ->

 	    terminate(What, Name, Msg, Mod, State, []);

 	_ ->

 	    terminate({bad_return_value, Reply}, Name, Msg, Mod, State, [])

     end.

 handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Queue, Debug) ->

     case Reply of

 	{noreply, NState} ->

 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,

 				      {noreply, NState}),

 	    loop(Parent, Name, NState, Mod, infinity, Queue, Debug1);

 	{noreply, NState, Time1} ->

 	    Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name,

 				      {noreply, NState}),

 	    loop(Parent, Name, NState, Mod, Time1, Queue, Debug1);

 	{stop, Reason, NState} ->

 	    terminate(Reason, Name, Msg, Mod, NState, Debug);

 	{'EXIT', What} ->

 	    terminate(What, Name, Msg, Mod, State, Debug);

 	_ ->

 	    terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug)

     end.

 reply(Name, {To, Tag}, Reply, State, Debug) ->

     reply({To, Tag}, Reply),

     sys:handle_debug(Debug, {?MODULE, print_event}, Name, 

 		     {out, Reply, To, State} ).

 %%-----------------------------------------------------------------

 %% Callback functions for system messages handling.

 %%-----------------------------------------------------------------

 system_continue(Parent, Debug, [Name, State, Mod, Time, Queue]) ->

     loop(Parent, Name, State, Mod, Time, Queue, Debug).

 system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time, _Queue]) ->

     terminate(Reason, Name, [], Mod, State, Debug).

 system_code_change([Name, State, Mod, Time, Queue], _Module, OldVsn, Extra) ->

     case catch Mod:code_change(OldVsn, State, Extra) of

 	{ok, NewState} -> {ok, [Name, NewState, Mod, Time, Queue]};

 	Else -> Else

     end.

 %%-----------------------------------------------------------------

 %% Format debug messages.  Print them as the call-back module sees

 %% them, not as the real erlang messages.  Use trace for that.

 %%-----------------------------------------------------------------

 print_event(Dev, {in, Msg}, Name) ->

     case Msg of

 	{'$gen_call', {From, _Tag}, Call} ->

 	    io:format(Dev, "*DBG* ~p got call ~p from ~w~n",

 		      [Name, Call, From]);

 	{'$gen_cast', Cast} ->

 	    io:format(Dev, "*DBG* ~p got cast ~p~n",

 		      [Name, Cast]);

 	_ ->

 	    io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])

     end;

 print_event(Dev, {out, Msg, To, State}, Name) ->

     io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", 

 	      [Name, Msg, To, State]);

 print_event(Dev, {noreply, State}, Name) ->

     io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);

 print_event(Dev, Event, Name) ->

     io:format(Dev, "*DBG* ~p dbg  ~p~n", [Name, Event]).

 %%% ---------------------------------------------------

 %%% Terminate the server.

 %%% ---------------------------------------------------

 terminate(Reason, Name, Msg, Mod, State, Debug) ->

     case catch Mod:terminate(Reason, State) of

 	{'EXIT', R} ->

 	    error_info(R, Name, Msg, State, Debug),

 	    exit(R);

 	_ ->

 	    case Reason of

 		normal ->

 		    exit(normal);

 		shutdown ->

 		    exit(shutdown);

 		_ ->

 		    error_info(Reason, Name, Msg, State, Debug),

 		    exit(Reason)

 	    end

     end.

 error_info(_Reason, application_controller, _Msg, _State, _Debug) ->

     %% OTP-5811 Don't send an error report if it's the system process

     %% application_controller which is terminating - let init take care

     %% of it instead

     ok;

 error_info(Reason, Name, Msg, State, Debug) ->

     Reason1 = 

 	case Reason of

 	    {undef,[{M,F,A}|MFAs]} ->

 		case code:is_loaded(M) of

 		    false ->

 			{'module could not be loaded',[{M,F,A}|MFAs]};

 		    _ ->

 			case erlang:function_exported(M, F, length(A)) of

 			    true ->

 				Reason;

 			    false ->

 				{'function not exported',[{M,F,A}|MFAs]}

 			end

 		end;

 	    _ ->

 		Reason

 	end,    

     format("** Generic server ~p terminating \n"

            "** Last message in was ~p~n"

            "** When Server state == ~p~n"

            "** Reason for termination == ~n** ~p~n",

 	   [Name, Msg, State, Reason1]),

     sys:print_log(Debug),

     ok.

 %%% ---------------------------------------------------

 %%% Misc. functions.

 %%% ---------------------------------------------------

 opt(Op, [{Op, Value}|_]) ->

     {ok, Value};

 opt(Op, [_|Options]) ->

     opt(Op, Options);

 opt(_, []) ->

     false.

 debug_options(Name, Opts) ->

     case opt(debug, Opts) of

 	{ok, Options} -> dbg_options(Name, Options);

 	_ -> dbg_options(Name, [])

     end.

 dbg_options(Name, []) ->

     Opts = 

 	case init:get_argument(generic_debug) of

 	    error ->

 		[];

 	    _ ->

 		[log, statistics]

 	end,

     dbg_opts(Name, Opts);

 dbg_options(Name, Opts) ->

     dbg_opts(Name, Opts).

 dbg_opts(Name, Opts) ->

     case catch sys:debug_options(Opts) of

 	{'EXIT',_} ->

 	    format("~p: ignoring erroneous debug options - ~p~n",

 		   [Name, Opts]),

 	    [];

 	Dbg ->

 	    Dbg

     end.

 get_proc_name(Pid) when is_pid(Pid) ->

     Pid;

 get_proc_name({local, Name}) ->

     case process_info(self(), registered_name) of

 	{registered_name, Name} ->

 	    Name;

 	{registered_name, _Name} ->

 	    exit(process_not_registered);

 	[] ->

 	    exit(process_not_registered)

     end;    

 get_proc_name({global, Name}) ->

     case global:safe_whereis_name(Name) of

 	undefined ->

 	    exit(process_not_registered_globally);

 	Pid when Pid =:= self() ->

 	    Name;

 	_Pid ->

 	    exit(process_not_registered_globally)

     end.

 get_parent() ->

     case get('$ancestors') of

 	[Parent | _] when is_pid(Parent)->

             Parent;

         [Parent | _] when is_atom(Parent)->

             name_to_pid(Parent);

 	_ ->

 	    exit(process_was_not_started_by_proc_lib)

     end.

 name_to_pid(Name) ->

     case whereis(Name) of

 	undefined ->

 	    case global:safe_whereis_name(Name) of

 		undefined ->

 		    exit(could_not_find_registerd_name);

 		Pid ->

 		    Pid

 	    end;

 	Pid ->

 	    Pid

     end.

 %%-----------------------------------------------------------------

 %% Status information

 %%-----------------------------------------------------------------

 format_status(Opt, StatusData) ->

     [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time, Queue]] =

         StatusData,

     NameTag = if is_pid(Name) ->

 		      pid_to_list(Name);

 		 is_atom(Name) ->

 		      Name

 	      end,

     Header = lists:concat(["Status for generic server ", NameTag]),

     Log = sys:get_debug(log, Debug, []),

     Specfic = 

 	case erlang:function_exported(Mod, format_status, 2) of

 	    true ->

 		case catch Mod:format_status(Opt, [PDict, State]) of

 		    {'EXIT', _} -> [{data, [{"State", State}]}];

 		    Else -> Else

 		end;

 	    _ ->

 		[{data, [{"State", State}]}]

 	end,

     [{header, Header},

      {data, [{"Status", SysState},

 	     {"Parent", Parent},

 	     {"Logged events", Log},

              {"Queued messages", queue:to_list(Queue)}]} |

      Specfic].