1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(gen_event).
21
22%%%
23%%% A general event handler.
24%%% Several handlers (functions) can be added.
25%%% Each handler holds a state and will be called
26%%% for every event received of the handler.
27%%%
28
29%%% Modified by Magnus.
30%%%       Take care of fault situations and made notify asynchronous.
31%%% Re-written by Joe with new functional interface !
32%%% Modified by Martin - uses proc_lib, sys and gen!
33
34%%%
35%%% NOTE: If init_ack() return values are modified, see comment
36%%%       above monitor_return() in gen.erl!
37%%%
38
39-export([start/0, start/1, start/2,
40         start_link/0, start_link/1, start_link/2,
41         start_monitor/0, start_monitor/1, start_monitor/2,
42         stop/1, stop/3,
43	 notify/2, sync_notify/2,
44	 add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3,
45	 swap_sup_handler/3, which_handlers/1, call/3, call/4,
46         send_request/3, wait_response/2, receive_response/2, check_response/2,
47         wake_hib/5]).
48
49-export([init_it/6,
50	 system_continue/3,
51	 system_terminate/4,
52	 system_code_change/4,
53	 system_get_state/1,
54	 system_replace_state/2,
55	 format_status/2]).
56
57%% logger callback
58-export([format_log/1, format_log/2]).
59
60-export_type([handler/0, handler_args/0, add_handler_ret/0,
61              del_handler_ret/0]).
62
63-record(handler, {module             :: atom(),
64		  id = false,
65		  state,
66		  supervised = false :: 'false' | pid()}).
67
68-include("logger.hrl").
69
70%%%=========================================================================
71%%%  API
72%%%=========================================================================
73
74%% gen_event:start(Handler) -> {ok, Pid} | {error, What}
75%%   gen_event:add_handler(Handler, Mod, Args) -> ok | Other
76%%      gen_event:notify(Handler, Event) -> ok
77%%      gen_event:call(Handler, Mod, Query) -> {ok, Val} | {error, Why}
78%%      gen_event:call(Handler, Mod, Query, Timeout) -> {ok, Val} | {error, Why}
79%%   gen_event:delete_handler(Handler, Mod, Args) -> Val
80%%   gen_event:swap_handler(Handler, {OldMod, Args1}, {NewMod, Args2}) -> ok
81%%   gen_event:which_handler(Handler) -> [Mod]
82%% gen_event:stop(Handler) -> ok
83
84-callback init(InitArgs :: term()) ->
85    {ok, State :: term()} |
86    {ok, State :: term(), hibernate} |
87    {error, Reason :: term()}.
88-callback handle_event(Event :: term(), State :: term()) ->
89    {ok, NewState :: term()} |
90    {ok, NewState :: term(), hibernate} |
91    {swap_handler, Args1 :: term(), NewState :: term(),
92     Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
93    remove_handler.
94-callback handle_call(Request :: term(), State :: term()) ->
95    {ok, Reply :: term(), NewState :: term()} |
96    {ok, Reply :: term(), NewState :: term(), hibernate} |
97    {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(),
98     Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
99    {remove_handler, Reply :: term()}.
100-callback handle_info(Info :: term(), State :: term()) ->
101    {ok, NewState :: term()} |
102    {ok, NewState :: term(), hibernate} |
103    {swap_handler, Args1 :: term(), NewState :: term(),
104     Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
105    remove_handler.
106-callback terminate(Args :: (term() | {stop, Reason :: term()} |
107                             stop | remove_handler |
108                             {error, {'EXIT', Reason :: term()}} |
109                             {error, term()}),
110                    State :: term()) ->
111    term().
112-callback code_change(OldVsn :: (term() | {down, term()}),
113                      State :: term(), Extra :: term()) ->
114    {ok, NewState :: term()}.
115-callback format_status(Opt, StatusData) -> Status when
116      Opt :: 'normal' | 'terminate',
117      StatusData :: [PDict | State],
118      PDict :: [{Key :: term(), Value :: term()}],
119      State :: term(),
120      Status :: term().
121
122-optional_callbacks(
123    [handle_info/2, terminate/2, code_change/3, format_status/2]).
124
125%%---------------------------------------------------------------------------
126
127-type handler()          :: atom() | {atom(), term()}.
128-type handler_args()     :: term().
129-type add_handler_ret()  :: ok | term() | {'EXIT',term()}.
130-type del_handler_ret()  :: ok | term() | {'EXIT',term()}.
131
132-type emgr_name() :: {'local', atom()} | {'global', term()}
133                   | {'via', atom(), term()}.
134-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
135                    | {'logfile', string()}.
136-type option() :: {'timeout', timeout()}
137                | {'debug', [debug_flag()]}
138                | {'spawn_opt', [proc_lib:start_spawn_option()]}
139                | {'hibernate_after', timeout()}.
140-type emgr_ref()  :: atom() | {atom(), atom()} |  {'global', term()}
141                   | {'via', atom(), term()} | pid().
142-type start_ret() :: {'ok', pid()} | {'error', term()}.
143-type start_mon_ret() :: {'ok', {pid(),reference()}} | {'error', term()}.
144-type request_id() :: term().
145
146%%---------------------------------------------------------------------------
147
148-define(NO_CALLBACK, 'no callback module').
149
150%% -----------------------------------------------------------------
151%% Starts a generic event handler.
152%% start()
153%% start(MgrName | Options)
154%% start(MgrName, Options)
155%% start_link()
156%% start_link(MgrName | Options)
157%% start_link(MgrName, Options)
158%%    MgrName ::= {local, atom()} | {global, term()} | {via, atom(), term()}
159%%    Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}]
160%%       Flag ::= trace | log | {logfile, File} | statistics | debug
161%%          (debug == log && statistics)
162%% Returns: {ok, Pid} |
163%%          {error, {already_started, Pid}} |
164%%          {error, Reason}
165%% -----------------------------------------------------------------
166
167-spec start() -> start_ret().
168start() ->
169    gen:start(?MODULE, nolink, ?NO_CALLBACK, [], []).
170
171-spec start(emgr_name() | [option()]) -> start_ret().
172start(Name) when is_tuple(Name) ->
173    gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []);
174start(Options) when is_list(Options) ->
175    gen:start(?MODULE, nolink, ?NO_CALLBACK, [], Options).
176
177-spec start(emgr_name(), [option()]) -> start_ret().
178start(Name, Options) ->
179    gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], Options).
180
181-spec start_link() -> start_ret().
182start_link() ->
183    gen:start(?MODULE, link, ?NO_CALLBACK, [], []).
184
185-spec start_link(emgr_name() | [option()]) -> start_ret().
186start_link(Name) when is_tuple(Name) ->
187    gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []);
188start_link(Options) when is_list(Options) ->
189    gen:start(?MODULE, link, ?NO_CALLBACK, [], Options).
190
191-spec start_link(emgr_name(), [option()]) -> start_ret().
192start_link(Name, Options) ->
193    gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options).
194
195-spec start_monitor() -> start_mon_ret().
196start_monitor() ->
197    gen:start(?MODULE, monitor, ?NO_CALLBACK, [], []).
198
199-spec start_monitor(emgr_name() | [option()]) -> start_mon_ret().
200start_monitor(Name) when is_tuple(Name) ->
201    gen:start(?MODULE, monitor, Name, ?NO_CALLBACK, [], []);
202start_monitor(Options) when is_list(Options) ->
203    gen:start(?MODULE, monitor, ?NO_CALLBACK, [], Options).
204
205-spec start_monitor(emgr_name(), [option()]) -> start_mon_ret().
206start_monitor(Name, Options) ->
207    gen:start(?MODULE, monitor, Name, ?NO_CALLBACK, [], Options).
208
209%% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) ->
210init_it(Starter, self, Name, Mod, Args, Options) ->
211    init_it(Starter, self(), Name, Mod, Args, Options);
212init_it(Starter, Parent, Name0, _, _, Options) ->
213    process_flag(trap_exit, true),
214    Name = gen:name(Name0),
215    Debug = gen:debug_options(Name, Options),
216	HibernateAfterTimeout = gen:hibernate_after(Options),
217    proc_lib:init_ack(Starter, {ok, self()}),
218    loop(Parent, Name, [], HibernateAfterTimeout, Debug, false).
219
220-spec add_handler(emgr_ref(), handler(), term()) -> term().
221add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}).
222
223-spec add_sup_handler(emgr_ref(), handler(), term()) -> term().
224add_sup_handler(M, Handler, Args)  ->
225    rpc(M, {add_sup_handler, Handler, Args, self()}).
226
227-spec notify(emgr_ref(), term()) -> 'ok'.
228notify(M, Event) -> send(M, {notify, Event}).
229
230-spec sync_notify(emgr_ref(), term()) -> 'ok'.
231sync_notify(M, Event) -> rpc(M, {sync_notify, Event}).
232
233-spec call(emgr_ref(), handler(), term()) -> term().
234call(M, Handler, Query) -> call1(M, Handler, Query).
235
236-spec call(emgr_ref(), handler(), term(), timeout()) -> term().
237call(M, Handler, Query, Timeout) -> call1(M, Handler, Query, Timeout).
238
239-spec send_request(emgr_ref(), handler(), term()) -> request_id().
240send_request(M, Handler, Query) ->
241    gen:send_request(M, self(), {call, Handler, Query}).
242
243-spec wait_response(RequestId::request_id(), timeout()) ->
244        {reply, Reply::term()} | 'timeout' | {error, {Reason::term(), emgr_ref()}}.
245wait_response(RequestId, Timeout) ->
246    case gen:wait_response(RequestId, Timeout) of
247        {reply, {error, _} = Err} -> Err;
248        Return -> Return
249    end.
250
251-spec receive_response(RequestId::request_id(), timeout()) ->
252        {reply, Reply::term()} | 'timeout' | {error, {Reason::term(), emgr_ref()}}.
253receive_response(RequestId, Timeout) ->
254    case gen:receive_response(RequestId, Timeout) of
255        {reply, {error, _} = Err} -> Err;
256        Return -> Return
257    end.
258
259-spec check_response(Msg::term(), RequestId::request_id()) ->
260        {reply, Reply::term()} | 'no_reply' | {error, {Reason::term(), emgr_ref()}}.
261check_response(Msg, RequestId) ->
262    case gen:check_response(Msg, RequestId)  of
263        {reply, {error, _} = Err} -> Err;
264        Return -> Return
265    end.
266
267-spec delete_handler(emgr_ref(), handler(), term()) -> term().
268delete_handler(M, Handler, Args) -> rpc(M, {delete_handler, Handler, Args}).
269
270-spec swap_handler(emgr_ref(), {handler(), term()}, {handler(), term()}) ->
271	    'ok' | {'error', term()}.
272swap_handler(M, {H1, A1}, {H2, A2}) -> rpc(M, {swap_handler, H1, A1, H2, A2}).
273
274-spec swap_sup_handler(emgr_ref(), {handler(), term()}, {handler(), term()}) ->
275	    'ok' | {'error', term()}.
276swap_sup_handler(M, {H1, A1}, {H2, A2}) ->
277    rpc(M, {swap_sup_handler, H1, A1, H2, A2, self()}).
278
279-spec which_handlers(emgr_ref()) -> [handler()].
280which_handlers(M) -> rpc(M, which_handlers).
281
282-spec stop(emgr_ref()) -> 'ok'.
283stop(M) ->
284    gen:stop(M).
285
286stop(M, Reason, Timeout) ->
287    gen:stop(M, Reason, Timeout).
288
289rpc(M, Cmd) ->
290    {ok, Reply} = gen:call(M, self(), Cmd, infinity),
291    Reply.
292
293call1(M, Handler, Query) ->
294    Cmd = {call, Handler, Query},
295    try gen:call(M, self(), Cmd) of
296	{ok, Res} ->
297	    Res
298    catch
299	exit:Reason ->
300	    exit({Reason, {?MODULE, call, [M, Handler, Query]}})
301    end.
302
303call1(M, Handler, Query, Timeout) ->
304    Cmd = {call, Handler, Query},
305    try gen:call(M, self(), Cmd, Timeout) of
306	{ok, Res} ->
307	    Res
308    catch
309	exit:Reason ->
310	    exit({Reason, {?MODULE, call, [M, Handler, Query, Timeout]}})
311    end.
312
313send({global, Name}, Cmd) ->
314    catch global:send(Name, Cmd),
315    ok;
316send({via, Mod, Name}, Cmd) ->
317    catch Mod:send(Name, Cmd),
318    ok;
319send(M, Cmd) ->
320    M ! Cmd,
321    ok.
322
323loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true) ->
324     proc_lib:hibernate(?MODULE, wake_hib, [Parent, ServerName, MSL, HibernateAfterTimeout, Debug]);
325loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, _) ->
326    fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false).
327
328wake_hib(Parent, ServerName, MSL, HibernateAfterTimeout, Debug) ->
329    fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true).
330
331fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, Hib) ->
332    receive
333	{system, From, Req} ->
334	    sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
335				  [ServerName, MSL, HibernateAfterTimeout, Hib],Hib);
336	{'EXIT', Parent, Reason} ->
337	    terminate_server(Reason, Parent, MSL, ServerName);
338	Msg when Debug =:= [] ->
339	    handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, []);
340	Msg ->
341	    Debug1 = sys:handle_debug(Debug, fun print_event/3,
342				      ServerName, {in, Msg}),
343	    handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, Debug1)
344    after HibernateAfterTimeout ->
345	    loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true)
346    end.
347
348handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, Debug) ->
349    case Msg of
350	{notify, Event} ->
351	    {Hib,MSL1} = server_notify(Event, handle_event, MSL, ServerName),
352	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
353	{_From, Tag, {sync_notify, Event}} ->
354	    {Hib, MSL1} = server_notify(Event, handle_event, MSL, ServerName),
355	    reply(Tag, ok),
356	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
357	{'EXIT', From, Reason} ->
358	    MSL1 = handle_exit(From, Reason, MSL, ServerName),
359	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, false);
360	{_From, Tag, {call, Handler, Query}} ->
361	    {Hib, Reply, MSL1} = server_call(Handler, Query, MSL, ServerName),
362	    reply(Tag, Reply),
363	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
364	{_From, Tag, {add_handler, Handler, Args}} ->
365	    {Hib, Reply, MSL1} = server_add_handler(Handler, Args, MSL),
366	    reply(Tag, Reply),
367	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
368	{_From, Tag, {add_sup_handler, Handler, Args, SupP}} ->
369	    {Hib, Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP),
370	    reply(Tag, Reply),
371	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
372	{_From, Tag, {delete_handler, Handler, Args}} ->
373	    {Reply, MSL1} = server_delete_handler(Handler, Args, MSL,
374						  ServerName),
375	    reply(Tag, Reply),
376	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, false);
377	{_From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} ->
378	    {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2,
379						     Args2, MSL, ServerName),
380	    reply(Tag, Reply),
381	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
382	{_From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2,
383		     Sup}} ->
384	    {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2,
385						Args2, MSL, Sup, ServerName),
386	    reply(Tag, Reply),
387	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib);
388	{_From, Tag, stop} ->
389	    catch terminate_server(normal, Parent, MSL, ServerName),
390	    reply(Tag, ok);
391	{_From, Tag, which_handlers} ->
392	    reply(Tag, the_handlers(MSL)),
393	    loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false);
394	{_From, Tag, get_modules} ->
395	    reply(Tag, get_modules(MSL)),
396	    loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false);
397	Other  ->
398	    {Hib, MSL1} = server_notify(Other, handle_info, MSL, ServerName),
399	    loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib)
400    end.
401
402terminate_server(Reason, Parent, MSL, ServerName) ->
403    stop_handlers(MSL, ServerName),
404    do_unlink(Parent, MSL),
405    exit(Reason).
406
407reply(From, Reply) ->
408    gen:reply(From, Reply).
409
410%% unlink the supervisor process of all supervised handlers.
411%% We do not want a handler supervisor to EXIT due to the
412%% termination of the event manager (server).
413%% Do not unlink Parent !
414do_unlink(Parent, MSL) ->
415    lists:foreach(fun(Handler) when Handler#handler.supervised =:= Parent ->
416			  true;
417		     (Handler) when is_pid(Handler#handler.supervised) ->
418			  unlink(Handler#handler.supervised),
419			  true;
420		     (_) ->
421			  true
422		  end,
423		  MSL).
424
425%% First terminate the supervised (if exists) handlers and
426%% then inform other handlers.
427%% We do not know if any handler really is interested but it
428%% may be so !
429handle_exit(From, Reason, MSL, SName) ->
430    MSL1 = terminate_supervised(From, Reason, MSL, SName),
431    {_,MSL2}=server_notify({'EXIT', From, Reason}, handle_info, MSL1, SName),
432    MSL2.
433
434terminate_supervised(Pid, Reason, MSL, SName) ->
435    F = fun(Ha) when Ha#handler.supervised =:= Pid ->
436		do_terminate(Ha#handler.module,
437			     Ha,
438			     {stop,Reason},
439			     Ha#handler.state,
440			     {parent_terminated, {Pid,Reason}},
441			     SName,
442			     shutdown),
443		false;
444	   (_) ->
445		true
446	end,
447    lists:filter(F, MSL).
448
449%%-----------------------------------------------------------------
450%% Callback functions for system messages handling.
451%%-----------------------------------------------------------------
452system_continue(Parent, Debug, [ServerName, MSL, HibernateAfterTimeout, Hib]) ->
453    loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, Hib).
454
455-spec system_terminate(_, _, _, [_]) -> no_return().
456system_terminate(Reason, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]) ->
457    terminate_server(Reason, Parent, MSL, ServerName).
458
459%%-----------------------------------------------------------------
460%% Module here is sent in the system msg change_code.  It specifies
461%% which module should be changed.
462%%-----------------------------------------------------------------
463system_code_change([ServerName, MSL, HibernateAfterTimeout, Hib], Module, OldVsn, Extra) ->
464    MSL1 = lists:zf(fun(H) when H#handler.module =:= Module ->
465			    {ok, NewState} =
466				Module:code_change(OldVsn,
467						   H#handler.state, Extra),
468			    {true, H#handler{state = NewState}};
469		       (_) -> true
470		    end,
471		    MSL),
472    {ok, [ServerName, MSL1, HibernateAfterTimeout, Hib]}.
473
474system_get_state([_ServerName, MSL, _HibernateAfterTimeout, _Hib]) ->
475    {ok, [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL]}.
476
477system_replace_state(StateFun, [ServerName, MSL, HibernateAfterTimeout, Hib]) ->
478    {NMSL, NStates} =
479		lists:unzip([begin
480				 Cur = {Mod,Id,State},
481				 try
482				     NState = {Mod,Id,NS} = StateFun(Cur),
483				     {HS#handler{state=NS}, NState}
484				 catch
485				     _:_ ->
486					 {HS, Cur}
487				 end
488			     end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]),
489    {ok, NStates, [ServerName, NMSL, HibernateAfterTimeout, Hib]}.
490
491%%-----------------------------------------------------------------
492%% Format debug messages.  Print them as the call-back module sees
493%% them, not as the real erlang messages.  Use trace for that.
494%%-----------------------------------------------------------------
495print_event(Dev, {in, Msg}, Name) ->
496    case Msg of
497	{notify, Event} ->
498	    io:format(Dev, "*DBG* ~tp got event ~tp~n", [Name, Event]);
499	{_,_,{call, Handler, Query}} ->
500	    io:format(Dev, "*DBG* ~tp(~tp) got call ~tp~n",
501		      [Name, Handler, Query]);
502	_ ->
503	    io:format(Dev, "*DBG* ~tp got ~tp~n", [Name, Msg])
504    end;
505print_event(Dev, Dbg, Name) ->
506    io:format(Dev, "*DBG* ~tp : ~tp~n", [Name, Dbg]).
507
508
509%% server_add_handler(Handler, Args, MSL) -> {Ret, MSL'}.
510%%   where MSL = [#handler{}]
511%%   Ret goes to the top level MSL' is the new internal state of the
512%%   event handler
513
514server_add_handler({Mod,Id}, Args, MSL) ->
515    Handler = #handler{module = Mod,
516		       id = Id},
517    server_add_handler(Mod, Handler, Args, MSL);
518server_add_handler(Mod, Args, MSL) ->
519    Handler = #handler{module = Mod},
520    server_add_handler(Mod, Handler, Args, MSL).
521
522server_add_handler(Mod, Handler, Args, MSL) ->
523    case catch Mod:init(Args) of
524        {ok, State} ->
525	    {false, ok, [Handler#handler{state = State}|MSL]};
526        {ok, State, hibernate} ->
527	    {true, ok, [Handler#handler{state = State}|MSL]};
528        Other ->
529            {false, Other, MSL}
530    end.
531
532%% Set up a link to the supervising process.
533%% (Ought to be unidirected links here, Erl5.0 !!)
534%% NOTE: This link will not be removed then the
535%% handler is removed in case another handler has
536%% own link to this process.
537server_add_sup_handler({Mod,Id}, Args, MSL, Parent) ->
538    link(Parent),
539    Handler = #handler{module = Mod,
540		       id = Id,
541		       supervised = Parent},
542    server_add_handler(Mod, Handler, Args, MSL);
543server_add_sup_handler(Mod, Args, MSL, Parent) ->
544    link(Parent),
545    Handler = #handler{module = Mod,
546		       supervised = Parent},
547    server_add_handler(Mod, Handler, Args, MSL).
548
549%% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'}
550
551server_delete_handler(HandlerId, Args, MSL, SName) ->
552    case split(HandlerId, MSL) of
553	{Mod, Handler, MSL1} ->
554	    {do_terminate(Mod, Handler, Args,
555			  Handler#handler.state, delete, SName, normal),
556	     MSL1};
557	error ->
558	    {{error, module_not_found}, MSL}
559    end.
560
561%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SN) -> MSL'
562%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SN) -> MSL'
563
564server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SName) ->
565    {State2, Sup, MSL1} = split_and_terminate(Handler1, Args1, MSL,
566					      SName, Handler2, false),
567    case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of
568	{Hib, ok, MSL2} ->
569	    {Hib, ok, MSL2};
570	{Hib, What, MSL2} ->
571	    {Hib, {error, What}, MSL2}
572    end.
573
574server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SName) ->
575    {State2, _, MSL1} = split_and_terminate(Handler1, Args1, MSL,
576					    SName, Handler2, Sup),
577    case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of
578	{Hib, ok, MSL2} ->
579	    {Hib, ok, MSL2};
580	{Hib, What, MSL2} ->
581	    {Hib, {error, What}, MSL2}
582    end.
583
584s_s_h(false, Handler, Args, MSL) ->
585    server_add_handler(Handler, Args, MSL);
586s_s_h(Pid, Handler, Args, MSL) ->
587    server_add_sup_handler(Handler, Args, MSL, Pid).
588
589split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) ->
590    case split(HandlerId, MSL) of
591	{Mod, Handler, MSL1} ->
592	    OldSup = Handler#handler.supervised,
593	    NewSup = if
594			 not Sup -> OldSup;
595			 true    -> Sup
596		     end,
597	    {do_terminate(Mod, Handler, Args,
598			  Handler#handler.state, swapped, SName,
599			  {swapped, Handler2, NewSup}),
600	     OldSup,
601	     MSL1};
602	error ->
603            {error, false, MSL}
604    end.
605
606%% server_notify(Event, Func, MSL, SName) -> MSL'
607
608server_notify(Event, Func, [Handler|T], SName) ->
609    case server_update(Handler, Func, Event, SName) of
610	{ok, Handler1} ->
611	    {Hib, NewHandlers} = server_notify(Event, Func, T, SName),
612	    {Hib, [Handler1|NewHandlers]};
613	{hibernate, Handler1} ->
614	    {_Hib, NewHandlers} = server_notify(Event, Func, T, SName),
615	    {true, [Handler1|NewHandlers]};
616	no ->
617	    server_notify(Event, Func, T, SName)
618    end;
619server_notify(_, _, [], _) ->
620    {false, []}.
621
622%% server_update(Handler, Func, Event, ServerName) -> Handler1 | no
623
624server_update(Handler1, Func, Event, SName) ->
625    Mod1 = Handler1#handler.module,
626    State = Handler1#handler.state,
627    case catch Mod1:Func(Event, State) of
628	{ok, State1} ->
629	    {ok, Handler1#handler{state = State1}};
630	{ok, State1, hibernate} ->
631	    {hibernate, Handler1#handler{state = State1}};
632	{swap_handler, Args1, State1, Handler2, Args2} ->
633	    do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName);
634	remove_handler ->
635	    do_terminate(Mod1, Handler1, remove_handler, State,
636			 remove, SName, normal),
637	    no;
638        {'EXIT', {undef, [{Mod1, handle_info, [_,_], _}|_]}} ->
639            ?LOG_WARNING(#{label=>{gen_event,no_handle_info},
640                           module=>Mod1,
641                           message=>Event},
642                         #{domain=>[otp],
643                           report_cb=>fun gen_event:format_log/2,
644                           error_logger=>
645                               #{tag=>warning_msg, % warningmap??
646                                 report_cb=>fun gen_event:format_log/1}}),
647            {ok, Handler1};
648	Other ->
649	    do_terminate(Mod1, Handler1, {error, Other}, State,
650			 Event, SName, crash),
651	    no
652    end.
653
654do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName) ->
655    %% finalise the existing handler
656    State2 = do_terminate(Mod1, Handler1, Args1, State1,
657			  swapped, SName,
658			  {swapped, Handler2, Handler1#handler.supervised}),
659    {Mod2, Handler} = new_handler(Handler2, Handler1),
660    case catch Mod2:init({Args2, State2}) of
661	{ok, State2a} ->
662	    {ok, Handler#handler{state = State2a}};
663	Other ->
664	    report_terminate(Handler, crash, {error, Other}, SName, false),
665	    no
666    end.
667
668new_handler({Mod,Id}, Handler1) ->
669    {Mod, #handler{module = Mod,
670		   id = Id,
671		   supervised = Handler1#handler.supervised}};
672new_handler(Mod, Handler1) ->
673    {Mod, #handler{module = Mod,
674		   supervised = Handler1#handler.supervised}}.
675
676
677-spec split(handler(), [#handler{}]) ->
678	{atom(), #handler{}, [#handler{}]} | 'error'.
679
680split(Ha, MSL) -> split(Ha, MSL, []).
681
682split({Mod,Id}, [Ha|T], L) when Ha#handler.module =:= Mod,
683                                Ha#handler.id =:= Id ->
684    {Mod, Ha, lists:reverse(L, T)};
685split(Mod, [Ha|T], L) when Ha#handler.module =:= Mod,
686                           not Ha#handler.id ->
687    {Mod, Ha, lists:reverse(L, T)};
688split(Ha, [H|T], L) ->
689    split(Ha, T, [H|L]);
690split(_, [], _) ->
691    error.
692
693%% server_call(Handler, Query, MSL, ServerName) ->
694%%    {Reply, MSL1}
695
696server_call(Handler, Query, MSL, SName) ->
697    case search(Handler, MSL) of
698	{ok, Ha} ->
699	    case server_call_update(Ha, Query, SName) of
700		{no, Reply} ->
701		    {false, Reply, delete(Handler, MSL)};
702		{{ok, Ha1}, Reply} ->
703		    {false, Reply, replace(Handler, MSL, Ha1)};
704		{{hibernate, Ha1}, Reply} ->
705		    {true, Reply, replace(Handler, MSL, Ha1)}
706	    end;
707	false ->
708	    {false, {error, bad_module}, MSL}
709    end.
710
711search({Mod, Id}, [Ha|_MSL]) when Ha#handler.module =:= Mod,
712				  Ha#handler.id =:= Id ->
713    {ok, Ha};
714search(Mod, [Ha|_MSL]) when Ha#handler.module =:= Mod,
715			    not Ha#handler.id ->
716    {ok, Ha};
717search(Handler, [_|MSL]) ->
718    search(Handler, MSL);
719search(_, []) ->
720    false.
721
722delete({Mod, Id}, [Ha|MSL]) when Ha#handler.module =:= Mod,
723                                 Ha#handler.id =:= Id ->
724    MSL;
725delete(Mod, [Ha|MSL]) when Ha#handler.module =:= Mod,
726                           not Ha#handler.id ->
727    MSL;
728delete(Handler, [Ha|MSL]) ->
729    [Ha|delete(Handler, MSL)];
730delete(_, []) ->
731    [].
732
733replace({Mod, Id}, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod,
734                                         Ha#handler.id =:= Id ->
735    [NewHa|MSL];
736replace(Mod, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod,
737                                   not Ha#handler.id ->
738    [NewHa|MSL];
739replace(Handler, [Ha|MSL], NewHa) ->
740    [Ha|replace(Handler, MSL, NewHa)];
741replace(_, [], NewHa) ->
742    [NewHa].
743
744%% server_call_update(Handler, Query, ServerName) ->
745%%    {{Handler1, State1} | 'no', Reply}
746
747server_call_update(Handler1, Query, SName) ->
748    Mod1 = Handler1#handler.module,
749    State = Handler1#handler.state,
750    case catch Mod1:handle_call(Query, State) of
751	{ok, Reply, State1} ->
752	    {{ok, Handler1#handler{state = State1}}, Reply};
753	{ok, Reply, State1, hibernate} ->
754	    {{hibernate, Handler1#handler{state = State1}},
755	     Reply};
756	{swap_handler, Reply, Args1, State1, Handler2, Args2} ->
757	    {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply};
758	{remove_handler, Reply} ->
759	    do_terminate(Mod1, Handler1, remove_handler, State,
760			 remove, SName, normal),
761	    {no, Reply};
762	Other ->
763	    do_terminate(Mod1, Handler1, {error, Other}, State,
764			 Query, SName, crash),
765	    {no, {error, Other}}
766    end.
767
768do_terminate(Mod, Handler, Args, State, LastIn, SName, Reason) ->
769    case erlang:function_exported(Mod, terminate, 2) of
770	true ->
771	    Res = (catch Mod:terminate(Args, State)),
772	    report_terminate(Handler, Reason, Args, State, LastIn, SName, Res),
773	    Res;
774	false ->
775	    report_terminate(Handler, Reason, Args, State, LastIn, SName, ok),
776	    ok
777    end.
778
779report_terminate(Handler, crash, {error, Why}, State, LastIn, SName, _) ->
780    report_terminate(Handler, Why, State, LastIn, SName);
781report_terminate(Handler, How, _, State, LastIn, SName, _) ->
782    %% How == normal | shutdown | {swapped, NewHandler, NewSupervisor}
783    report_terminate(Handler, How, State, LastIn, SName).
784
785report_terminate(Handler, Reason, State, LastIn, SName) ->
786    report_error(Handler, Reason, State, LastIn, SName),
787    case Handler#handler.supervised of
788	false ->
789	    ok;
790	Pid ->
791	    Pid ! {gen_event_EXIT,handler(Handler),Reason},
792	    ok
793    end.
794
795report_error(_Handler, normal, _, _, _)             -> ok;
796report_error(_Handler, shutdown, _, _, _)           -> ok;
797report_error(_Handler, {swapped,_,_}, _, _, _)      -> ok;
798report_error(Handler, Reason, State, LastIn, SName) ->
799    ?LOG_ERROR(#{label=>{gen_event,terminate},
800                 handler=>handler(Handler),
801                 name=>SName,
802                 last_message=>LastIn,
803                 state=>format_status(terminate,Handler#handler.module,
804                                      get(),State),
805                 reason=>Reason},
806               #{domain=>[otp],
807                 report_cb=>fun gen_event:format_log/2,
808                 error_logger=>#{tag=>error,
809                                 report_cb=>fun gen_event:format_log/1}}).
810
811%% format_log/1 is the report callback used by Logger handler
812%% error_logger only. It is kept for backwards compatibility with
813%% legacy error_logger event handlers. This function must always
814%% return {Format,Args} compatible with the arguments in this module's
815%% calls to error_logger prior to OTP-21.0.
816format_log(Report) ->
817    Depth = error_logger:get_format_depth(),
818    FormatOpts = #{chars_limit => unlimited,
819                   depth => Depth,
820                   single_line => false,
821                   encoding => utf8},
822    format_log_multi(limit_report(Report, Depth), FormatOpts).
823
824limit_report(Report, unlimited) ->
825    Report;
826limit_report(#{label:={gen_event,terminate},
827               last_message:=LastIn,
828               state:=State,
829               reason:=Reason}=Report,
830             Depth) ->
831    Report#{last_message => io_lib:limit_term(LastIn, Depth),
832            state => io_lib:limit_term(State, Depth),
833            reason => io_lib:limit_term(Reason, Depth)};
834limit_report(#{label:={gen_event,no_handle_info},
835               message:=Msg}=Report,
836             Depth) ->
837    Report#{message => io_lib:limit_term(Msg, Depth)}.
838
839%% format_log/2 is the report callback for any Logger handler, except
840%% error_logger.
841format_log(Report, FormatOpts0) ->
842    Default = #{chars_limit => unlimited,
843                depth => unlimited,
844                single_line => false,
845                encoding => utf8},
846    FormatOpts = maps:merge(Default, FormatOpts0),
847    IoOpts =
848        case FormatOpts of
849            #{chars_limit:=unlimited} ->
850                [];
851            #{chars_limit:=Limit} ->
852                [{chars_limit,Limit}]
853        end,
854    {Format,Args} = format_log_single(Report, FormatOpts),
855    io_lib:format(Format, Args, IoOpts).
856
857format_log_single(#{label:={gen_event,terminate},
858                    handler:=Handler,
859                    name:=SName,
860                    last_message:=LastIn,
861                    state:=State,
862                    reason:=Reason},
863                  #{single_line:=true, depth:=Depth}=FormatOpts) ->
864    P = p(FormatOpts),
865    Reason1 = fix_reason(Reason),
866    Format1 = lists:append(["Generic event handler ",P," crashed. "
867                            "Installed: ",P,". Last event: ",P,
868                            ". State: ",P,". Reason: ",P,"."]),
869    Args1 =
870        case Depth of
871            unlimited ->
872                [Handler,SName,Reason1,LastIn,State];
873            _ ->
874                [Handler,Depth,SName,Depth,Reason1,Depth,
875                 LastIn,Depth,State,Depth]
876        end,
877    {Format1, Args1};
878format_log_single(#{label:={gen_event,no_handle_info},
879                    module:=Mod,
880                    message:=Msg},
881                  #{single_line:=true,depth:=Depth}=FormatOpts) ->
882    P = p(FormatOpts),
883    Format = lists:append(["Undefined handle_info in ",P,
884                           ". Unhandled message: ",P,"."]),
885    Args =
886        case Depth of
887            unlimited ->
888                [Mod,Msg];
889            _ ->
890                [Mod,Depth,Msg,Depth]
891        end,
892    {Format,Args};
893format_log_single(Report,FormatOpts) ->
894    format_log_multi(Report,FormatOpts).
895
896format_log_multi(#{label:={gen_event,terminate},
897                   handler:=Handler,
898                   name:=SName,
899                   last_message:=LastIn,
900                   state:=State,
901                   reason:=Reason},
902                 #{depth:=Depth}=FormatOpts) ->
903    Reason1 = fix_reason(Reason),
904    P = p(FormatOpts),
905    Format =
906        lists:append(["** gen_event handler ",P," crashed.\n",
907                      "** Was installed in ",P,"\n",
908                      "** Last event was: ",P,"\n",
909                      "** When handler state == ",P,"\n",
910                      "** Reason == ",P,"\n"]),
911    Args =
912        case Depth of
913            unlimited ->
914                [Handler,SName,LastIn,State,Reason1];
915            _ ->
916                [Handler,Depth,SName,Depth,LastIn,Depth,State,Depth,
917                 Reason1,Depth]
918        end,
919    {Format,Args};
920format_log_multi(#{label:={gen_event,no_handle_info},
921                   module:=Mod,
922                   message:=Msg},
923                 #{depth:=Depth}=FormatOpts) ->
924    P = p(FormatOpts),
925    Format =
926        "** Undefined handle_info in ~p\n"
927        "** Unhandled message: "++P++"\n",
928    Args =
929        case Depth of
930            unlimited ->
931                [Mod,Msg];
932            _ ->
933                [Mod,Msg,Depth]
934        end,
935    {Format,Args}.
936
937fix_reason({'EXIT',{undef,[{M,F,A,_L}|_]=MFAs}=Reason}) ->
938    case code:is_loaded(M) of
939        false ->
940            {'module could not be loaded',MFAs};
941        _ ->
942            case erlang:function_exported(M, F, length(A)) of
943                true ->
944                    Reason;
945                false ->
946                    {'function not exported',MFAs}
947            end
948    end;
949fix_reason({'EXIT',Reason}) ->
950    Reason;
951fix_reason(Reason) ->
952    Reason.
953
954p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) ->
955    "~"++single(Single)++mod(Enc)++p(Depth);
956p(unlimited) ->
957    "p";
958p(_Depth) ->
959    "P".
960
961single(true) -> "0";
962single(false) -> "".
963
964mod(latin1) -> "";
965mod(_) -> "t".
966
967handler(Handler) when not Handler#handler.id ->
968    Handler#handler.module;
969handler(Handler) ->
970    {Handler#handler.module, Handler#handler.id}.
971
972the_handlers(MSL) ->
973    [handler(Handler) || Handler <- MSL].
974
975%% stop_handlers(MSL, ServerName) -> []
976
977stop_handlers([Handler|T], SName) ->
978    Mod = Handler#handler.module,
979    do_terminate(Mod, Handler, stop, Handler#handler.state,
980		 stop, SName, shutdown),
981    stop_handlers(T, SName);
982stop_handlers([], _) ->
983    [].
984
985%% Message from the release_handler.
986%% The list of modules got to be a set, i.e. no duplicate elements!
987get_modules(MSL) ->
988    Mods = [Handler#handler.module || Handler <- MSL],
989    ordsets:to_list(ordsets:from_list(Mods)).
990
991%%-----------------------------------------------------------------
992%% Status information
993%%-----------------------------------------------------------------
994format_status(Opt, StatusData) ->
995    [PDict, SysState, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]] = StatusData,
996    Header = gen:format_status_header("Status for event handler",
997                                      ServerName),
998    FmtMSL = [MS#handler{state=format_status(Opt, Mod, PDict, State)}
999              || #handler{module = Mod, state = State} = MS <- MSL],
1000    [{header, Header},
1001     {data, [{"Status", SysState},
1002	     {"Parent", Parent}]},
1003     {items, {"Installed handlers", FmtMSL}}].
1004
1005format_status(Opt, Mod, PDict, State) ->
1006    case erlang:function_exported(Mod, format_status, 2) of
1007        true ->
1008            Args = [PDict, State],
1009            case catch Mod:format_status(Opt, Args) of
1010                {'EXIT', _} -> State;
1011                Else -> Else
1012            end;
1013        false ->
1014            State
1015    end.
1016