1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2001-2016. 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
21%%
22%%----------------------------------------------------------------------
23%% Purpose: The top supervisor for the Megaco/H.248 application
24%%----------------------------------------------------------------------
25
26-module(megaco_sup).
27
28-behaviour(application).
29-behaviour(supervisor).
30
31%% public
32-export([start/0, start/2, stop/1]).
33-export([start_sup_child/1, stop_sup_child/1]).
34
35%% internal
36-export([init/1]).
37
38%% debug
39-export([supervisor_timeout/1]).
40
41
42%% -define(d(F,A), io:format("~p~p:" ++ F ++ "~n", [self(),?MODULE|A])).
43-define(d(F,A), ok).
44
45
46%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
47%% application and supervisor callback functions
48
49start(normal, Args) ->
50    ?d("start(normal) -> entry with"
51	"~n   Args: ~p", [Args]),
52    SupName = {local, ?MODULE},
53    case supervisor:start_link(SupName, ?MODULE, [Args]) of
54	{ok, Pid} ->
55	    {ok, Pid, {normal, Args}};
56	Error ->
57	    Error
58    end;
59start(_, _) ->
60    {error, badarg}.
61
62start() ->
63    ?d("start -> entry", []),
64    SupName = {local,?MODULE},
65    supervisor:start_link(SupName, ?MODULE, []).
66
67stop(_StartArgs) ->
68    ok.
69
70init([]) -> % Supervisor
71    init();
72init([[]]) -> % Application
73    init();
74init(BadArg) ->
75    ?d("init -> entry when"
76	"~n   BadArg: ~p",[BadArg]),
77    {error, {badarg, BadArg}}.
78
79init() ->
80    ?d("init -> entry", []),
81    Flags = {one_for_one, 0, 1},
82    Sups = [sup_spec(megaco_misc_sup),
83	    sup_spec(megaco_trans_sup),
84	    worker_spec(megaco_config,  [gen_server]),
85	    worker_spec(megaco_monitor, [gen_server])],
86    ?d("init -> done when"
87	"~n   Flags: ~p"
88	"~n   Sups:  ~p", [Flags, Sups]),
89    {ok, {Flags, Sups}}.
90
91
92start_sup_child(Name) ->
93    ?d("start_sup_child -> entry with Name: ~p", [Name]),
94    Spec = sup_spec(Name),
95    supervisor:start_child(?MODULE, Spec).
96
97
98stop_sup_child(Name) ->
99    ?d("stop_sup_child -> entry with Name: ~p", [Name]),
100    ok = supervisor:terminate_child(?MODULE, Name),
101    ok = supervisor:delete_child(?MODULE, Name).
102
103
104
105sup_spec(Name) ->
106    {Name, {Name, start, []}, permanent, 2000, supervisor,[Name, supervisor]}.
107
108worker_spec(Name, Modules) ->
109    {Name, {Name, start_link, []}, permanent, 2000, worker, [Name] ++ Modules}.
110
111-ifdef(debug_shutdown).
112supervisor_timeout(_KillAfter) -> timer:hours(500).
113-else.
114supervisor_timeout(KillAfter) -> KillAfter.
115-endif.
116
117
118