1%%%-------------------------------------------------------------------
2%%% @author bartlomiej.gorny@erlang-solutions.com
3%%% @doc
4%%% This module handles formatting records for known record types.
5%%% Record definitions are imported from modules by user. Definitions are
6%%% distinguished by record name and its arity, if you have multiple records
7%%% of the same name and size, you have to choose one of them and some of your
8%%% records may be wrongly labelled. You can manipulate your definition list by
9%%% using import/1 and clear/1, and check which definitions are in use by executing
10%%% list/0.
11%%% @end
12%%%-------------------------------------------------------------------
13-module(recon_rec).
14-author("bartlomiej.gorny@erlang-solutions.com").
15%% API
16
17-export([is_active/0]).
18-export([import/1, clear/1, clear/0, list/0, get_list/0, limit/3]).
19-export([format_tuple/1]).
20
21-ifdef(TEST).
22-export([lookup_record/2]).
23-endif.
24
25% basic types
26-type field() :: atom().
27-type record_name() :: atom().
28% compound
29-type limit() :: all | none | field() | [field()].
30-type listentry() :: {module(), record_name(), [field()], limit()}.
31-type import_result() :: {imported, module(), record_name(), arity()}
32                       | {overwritten, module(), record_name(), arity()}
33                       | {ignored, module(), record_name(), arity(), module()}.
34
35%% @doc import record definitions from a module. If a record definition of the same name
36%% and arity has already been imported from another module then the new
37%% definition is ignored (returned info tells you from which module the existing definition was imported).
38%% You have to choose one and possibly remove the old one using
39%% clear/1. Supports importing multiple modules at once (by giving a list of atoms as
40%% an argument).
41%% @end
42-spec import(module() | [module()]) -> import_result() | [import_result()].
43import(Modules) when is_list(Modules) ->
44    lists:foldl(fun import/2, [], Modules);
45import(Module) ->
46    import(Module, []).
47
48%% @doc quickly check if we want to do any record formatting
49-spec is_active() -> boolean().
50is_active() ->
51    case whereis(recon_ets) of
52        undefined -> false;
53        _ -> true
54    end.
55
56%% @doc remove definitions imported from a module.
57clear(Module) ->
58    lists:map(fun(R) -> rem_for_module(R, Module) end, ets:tab2list(records_table_name())).
59
60%% @doc remove all imported definitions, destroy the table, clean up
61clear() ->
62    maybe_kill(recon_ets),
63    ok.
64
65%% @doc prints out all "known" (imported) record definitions and their limit settings.
66%% Printout tells module a record originates from, its name and a list of field names,
67%% plus the record's arity (may be handy if handling big records) and a list of field it
68%% limits its output to, if set.
69%% @end
70list() ->
71    F = fun({Module, Name, Fields, Limits}) ->
72            Fnames = lists:map(fun atom_to_list/1, Fields),
73            Flds = join(",", Fnames),
74            io:format("~p: #~p(~p){~s} ~p~n",
75                      [Module, Name, length(Fields), Flds, Limits])
76        end,
77    io:format("Module: #Name(Size){<Fields>} Limits~n==========~n", []),
78    lists:foreach(F, get_list()).
79
80%% @doc returns a list of active record definitions
81-spec get_list() -> [listentry()].
82get_list() ->
83    ensure_table_exists(),
84    Lst = lists:map(fun make_list_entry/1, ets:tab2list(records_table_name())),
85    lists:sort(Lst).
86
87%% @doc Limit output to selected fields of a record (can be 'none', 'all', a field or a list of fields).
88%% Limit set to 'none' means there is no limit, and all fields are displayed; limit 'all' means that
89%% all fields are squashed and only record name will be shown.
90%% @end
91-spec limit(record_name(), arity(), limit()) -> ok | {error, any()}.
92limit(Name, Arity, Limit) when is_atom(Name), is_integer(Arity) ->
93    case lookup_record(Name, Arity) of
94        [] ->
95            {error, record_unknown};
96        [{Key, Fields, Mod, _}] ->
97            ets:insert(records_table_name(), {Key, Fields, Mod, Limit}),
98            ok
99    end.
100
101%% @private if a tuple is a known record, formats is as "#recname{field=value}", otherwise returns
102%% just a printout of a tuple.
103format_tuple(Tuple) ->
104    ensure_table_exists(),
105    First = element(1, Tuple),
106    format_tuple(First, Tuple).
107
108%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
109%% PRIVATE
110%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
111
112
113make_list_entry({{Name, _}, Fields, Module, Limits}) ->
114    FmtLimit = case Limits of
115                   [] -> none;
116                   Other -> Other
117               end,
118    {Module, Name, Fields, FmtLimit}.
119
120import(Module, ResultList) ->
121    ensure_table_exists(),
122    lists:foldl(fun(Rec, Res) -> store_record(Rec, Module, Res) end,
123                ResultList,
124                get_record_defs(Module)).
125
126store_record(Rec, Module, ResultList) ->
127    {Name, Fields} = Rec,
128    Arity = length(Fields),
129    Result = case lookup_record(Name, Arity) of
130        [] ->
131            ets:insert(records_table_name(), rec_info(Rec, Module)),
132            {imported, Module, Name, Arity};
133        [{_, _, Module, _}] ->
134            ets:insert(records_table_name(), rec_info(Rec, Module)),
135            {overwritten, Module, Name, Arity};
136        [{_, _, Mod, _}] ->
137            {ignored, Module, Name, Arity, Mod}
138    end,
139    [Result | ResultList].
140
141get_record_defs(Module) ->
142    Path = code:which(Module),
143    {ok,{_,[{abstract_code,{_,AC}}]}} = beam_lib:chunks(Path, [abstract_code]),
144    lists:foldl(fun get_record/2, [], AC).
145
146get_record({attribute, _, record, Rec}, Acc) -> [Rec | Acc];
147get_record(_, Acc) -> Acc.
148
149%% @private
150lookup_record(RecName, FieldCount) ->
151    ensure_table_exists(),
152    ets:lookup(records_table_name(), {RecName, FieldCount}).
153
154%% @private
155ensure_table_exists() ->
156    case ets:info(records_table_name()) of
157        undefined ->
158            case whereis(recon_ets) of
159                undefined ->
160                    Parent = self(),
161                    Ref = make_ref(),
162                    %% attach to the currently running session
163                    {Pid, MonRef} = spawn_monitor(fun() ->
164                        register(recon_ets, self()),
165                        ets:new(records_table_name(), [set, public, named_table]),
166                        Parent ! Ref,
167                        ets_keeper()
168                    end),
169                    receive
170                        Ref ->
171                            erlang:demonitor(MonRef, [flush]),
172                            Pid;
173                        {'DOWN', MonRef, _, _, Reason} ->
174                            error(Reason)
175                    end;
176                Pid ->
177                    Pid
178            end;
179        Pid ->
180            Pid
181    end.
182
183records_table_name() -> recon_record_definitions.
184
185rec_info({Name, Fields}, Module) ->
186    {{Name, length(Fields)}, field_names(Fields), Module, none}.
187
188rem_for_module({_, _, Module, _} = Rec, Module) ->
189    ets:delete_object(records_table_name(), Rec);
190rem_for_module(_, _) ->
191    ok.
192
193ets_keeper() ->
194    receive
195        stop -> ok;
196        _ -> ets_keeper()
197    end.
198
199field_names(Fields) ->
200    lists:map(fun field_name/1, Fields).
201
202field_name({record_field, _, {atom, _, Name}}) -> Name;
203field_name({record_field, _, {atom, _, Name}, _Default}) -> Name;
204field_name({typed_record_field, Field, _Type}) -> field_name(Field).
205
206%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
207%% FORMATTER
208%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
209
210format_tuple(Name, Rec) when is_atom(Name) ->
211    case lookup_record(Name, size(Rec) - 1) of
212        [RecDef] -> format_record(Rec, RecDef);
213        _ ->
214            List = tuple_to_list(Rec),
215            ["{", join(", ", [recon_trace:format_trace_output(true, El) || El <- List]), "}"]
216    end;
217format_tuple(_, Tuple) ->
218    format_default(Tuple).
219
220format_default(Val) ->
221    io_lib:format("~p", [Val]).
222
223format_record(Rec, {{Name, Arity}, Fields, _, Limits}) ->
224    ExpectedLength = Arity + 1,
225    case tuple_size(Rec) of
226        ExpectedLength ->
227            [_ | Values] = tuple_to_list(Rec),
228            List = lists:zip(Fields, Values),
229            LimitedList = apply_limits(List, Limits),
230            ["#", atom_to_list(Name), "{",
231             join(", ", [format_kv(Key, Val) || {Key, Val} <- LimitedList]),
232             "}"];
233        _ ->
234            format_default(Rec)
235    end.
236
237format_kv(Key, Val) ->
238    %% Some messy mutually recursive calls we can't avoid
239    [recon_trace:format_trace_output(true, Key), "=", recon_trace:format_trace_output(true, Val)].
240
241apply_limits(List, none) -> List;
242apply_limits(_List, all) -> [];
243apply_limits(List, Field) when is_atom(Field) ->
244    [{Field, proplists:get_value(Field, List)}, {more, '...'}];
245apply_limits(List, Limits) ->
246    lists:filter(fun({K, _}) -> lists:member(K, Limits) end, List) ++ [{more, '...'}].
247
248%%%%%%%%%%%%%%%
249%%% HELPERS %%%
250%%%%%%%%%%%%%%%
251
252maybe_kill(Name) ->
253    case whereis(Name) of
254        undefined ->
255            ok;
256        Pid ->
257            unlink(Pid),
258            exit(Pid, kill),
259            wait_for_death(Pid, Name)
260    end.
261
262wait_for_death(Pid, Name) ->
263    case is_process_alive(Pid) orelse whereis(Name) =:= Pid of
264        true ->
265            timer:sleep(10),
266            wait_for_death(Pid, Name);
267        false ->
268            ok
269    end.
270
271-ifdef(OTP_RELEASE).
272-spec join(term(), [term()]) -> [term()].
273join(Sep, List) ->
274    lists:join(Sep, List).
275-else.
276-spec join(string(), [string()]) -> string().
277join(Sep, List) ->
278    string:join(List, Sep).
279-endif.
280