1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2005-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-module(otp_5436).
21-compile(export_all).
22
23?MODULE() ->
24    ok.
25
26-record(readerState, {action_index,
27                      log_index,
28                      log_name,
29                      time_period,
30                      rec_id_period,
31                      result_format,
32                      action_status,
33                      filter_type,
34                      event_list,
35                      sender_list,
36                      read_status}).
37
38handle_call(delete,_From,State) ->
39    case catch debug:filter(console,logReader) of
40        true ->
41            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,306,console,self(),sysAssert:format_time2(erlang:now())])|"delete, State: ~p ~n"],[State]) of
42                ok ->
43                    ok;
44                _ ->
45                    io:format("*** Bad format (~p, ~p) ***~n",["delete, State: ~p ~n",[State]]),
46                    ok
47            end;
48        false ->
49            disabled;
50        {'EXIT',{undef,_}} ->
51            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,306,console,self(),sysAssert:format_time2(erlang:now())])|"delete, State: ~p ~n"],[State]) of
52                ok ->
53                    ok;
54                _ ->
55                    io:format("*** Bad format (~p, ~p) ***~n",["delete, State: ~p ~n",[State]]),
56                    ok
57            end;
58        {'EXIT',_} ->
59            debug:filter(console,logReader);
60        _ ->
61            exit({badmatch,{{debug,filter,[console,logReader]},debug:filter(console,logReader)}})
62    end,
63    ?MODULE:clean_result(State),
64    {stop,normal,ok,State};
65handle_call(die,_,State) ->
66    {stop,normal,ok,State};
67handle_call(_Action,_From,#readerState{action_status = 2} = State) ->
68    {reply,error,State};
69handle_call(update_action_attr,_From,State) ->
70    NewState = ?MODULE:handle_update_action_attr(State),
71    case catch debug:filter(console,logReader) of
72        true ->
73            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,317,console,self(),sysAssert:format_time2(erlang:now())])|"update_action_attr, State: ~p ~n"],[NewState]) of
74                ok ->
75                    ok;
76                _ ->
77                    io:format("*** Bad format (~p, ~p) ***~n",["update_action_attr, State: ~p ~n",[NewState]]),
78                    ok
79            end;
80        false ->
81            disabled;
82        {'EXIT',{undef,_}} ->
83            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,317,console,self(),sysAssert:format_time2(erlang:now())])|"update_action_attr, State: ~p ~n"],[NewState]) of
84                ok ->
85                    ok;
86                _ ->
87                    io:format("*** Bad format (~p, ~p) ***~n",["update_action_attr, State: ~p ~n",[NewState]]),
88                    ok
89            end;
90        {'EXIT',_} ->
91            debug:filter(console,logReader);
92        _ ->
93            exit({badmatch,{{debug,filter,[console,logReader]},debug:filter(console,logReader)}})
94    end,
95    {reply,ok,NewState};
96handle_call(update_event_filter,_From,State) ->
97    NewState = State#readerState{event_list = ?MODULE:get_event_list(State#readerState.action_index)},
98    case catch debug:filter(console,logReader) of
99        true ->
100            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,323,console,self(),sysAssert:format_time2(erlang:now())])|"update_event_filter, State: ~p ~n"],[NewState]) of
101                ok ->
102                    ok;
103                _ ->
104                    io:format("*** Bad format (~p, ~p) ***~n",["update_event_filter, State: ~p ~n",[NewState]]),
105                    ok
106            end;
107        false ->
108            disabled;
109        {'EXIT',{undef,_}} ->
110            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,323,console,self(),sysAssert:format_time2(erlang:now())])|"update_event_filter, State: ~p ~n"],[NewState]) of
111                ok ->
112                    ok;
113                _ ->
114                    io:format("*** Bad format (~p, ~p) ***~n",["update_event_filter, State: ~p ~n",[NewState]]),
115                    ok
116            end;
117        {'EXIT',_} ->
118            debug:filter(console,logReader);
119        _ ->
120            exit({badmatch,{{debug,filter,[console,logReader]},debug:filter(console,logReader)}})
121    end,
122    {reply,ok,NewState};
123handle_call(update_sender_filter,_From,State) ->
124    NewState = State#readerState{sender_list = ?MODULE:get_sender_list(State#readerState.action_index)},
125    case catch debug:filter(console,logReader) of
126        true ->
127            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,329,console,self(),sysAssert:format_time2(erlang:now())])|"update_sender_filter, State: ~p ~n"],[NewState]) of
128                ok ->
129                    ok;
130                _ ->
131                    io:format("*** Bad format (~p, ~p) ***~n",["update_sender_filter, State: ~p ~n",[NewState]]),
132                    ok
133            end;
134        false ->
135            disabled;
136        {'EXIT',{undef,_}} ->
137            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,329,console,self(),sysAssert:format_time2(erlang:now())])|"update_sender_filter, State: ~p ~n"],[NewState]) of
138                ok ->
139                    ok;
140                _ ->
141                    io:format("*** Bad format (~p, ~p) ***~n",["update_sender_filter, State: ~p ~n",[NewState]]),
142                    ok
143            end;
144        {'EXIT',_} ->
145            debug:filter(console,logReader);
146        _ ->
147            exit({badmatch,{{debug,filter,[console,logReader]},debug:filter(console,logReader)}})
148    end,
149    {reply,ok,NewState};
150handle_call(Request,_From,State) ->
151    case catch debug:filter(console,logReader) of
152        true ->
153            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,332,console,self(),sysAssert:format_time2(erlang:now())])|"Call ~p, State: ~p ~n"],[Request,State]) of
154                ok ->
155                    ok;
156                _ ->
157                    io:format("*** Bad format (~p, ~p) ***~n",["Call ~p, State: ~p ~n",[Request,State]]),
158                    ok
159            end;
160        false ->
161            disabled;
162        {'EXIT',{undef,_}} ->
163            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,332,console,self(),sysAssert:format_time2(erlang:now())])|"Call ~p, State: ~p ~n"],[Request,State]) of
164                ok ->
165                    ok;
166                _ ->
167                    io:format("*** Bad format (~p, ~p) ***~n",["Call ~p, State: ~p ~n",[Request,State]]),
168                    ok
169            end;
170        {'EXIT',_} ->
171            debug:filter(console,logReader);
172        _ ->
173            exit({badmatch,{{debug,filter,[console,logReader]},debug:filter(console,logReader)}})
174    end,
175    {stop,{error,unknown,Request},State}.
176
177handle_info(Request,State) ->
178    case catch debug:filter(readlog,logReader) of
179        true ->
180            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,345,readlog,self(),sysAssert:format_time2(erlang:now())])|"Info ~p, State: ~p ~n"],[Request,State]) of
181                ok ->
182                    ok;
183                _ ->
184                    io:format("*** Bad format (~p, ~p) ***~n",["Info ~p, State: ~p ~n",[Request,State]]),
185                    ok
186            end;
187        false ->
188            disabled;
189        {'EXIT',{undef,_}} ->
190            case io:format([io_lib:format("~nSYS_DBG {~p,~p,~p}, ~w ~s:~n-- ",[logReader,345,readlog,self(),sysAssert:format_time2(erlang:now())])|"Info ~p, State: ~p ~n"],[Request,State]) of
191                ok ->
192                    ok;
193                _ ->
194                    io:format("*** Bad format (~p, ~p) ***~n",["Info ~p, State: ~p ~n",[Request,State]]),
195                    ok
196            end;
197        {'EXIT',_} ->
198            debug:filter(readlog,logReader);
199        _ ->
200            exit({badmatch,{{debug,filter,[readlog,logReader]},debug:filter(readlog,logReader)}})
201    end,
202    {stop,{error,unknown,Request},State}.
203