%%%---------------------------------------------------------------------- %%% File : funrelg.erl %%% Author : Badlop %%% Purpose : Function Relation Graph %%% Created : 3 Apr 2007 by Badlop %%% %%% %%% ejabberd, Copyright (C) 2002-2009 ProcessOne %%% %%% This program is free software; you can redistribute it and/or %%% modify it under the terms of the GNU General Public License as %%% published by the Free Software Foundation; either version 2 of the %%% License, or (at your option) any later version. %%% %%% This program is distributed in the hope that it will be useful, %%% but WITHOUT ANY WARRANTY; without even the implied warranty of %%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU %%% General Public License for more details. %%% %%% You should have received a copy of the GNU General Public License %%% along with this program; if not, write to the Free Software %%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA %%% 02111-1307 USA %%% %%%---------------------------------------------------------------------- -module(funrelg). -author('badlop@process-one.net'). -export([dir/1, file/1, g/0, g/1, gc/0, gc/1, d/0]). -record(mfa, {mod, func, arity}). -record(arcs, {id, from, to, occ}). %% The functions that are not in export and don't call anybody are not drawn %% The calls to this module that use Mod:Func are drawn as external calls %%----------------------------- %% Module handlers %%----------------------------- dir([SrcDir, OutDir]) -> SrcDirAbs = filename:absname(SrcDir), OutDirAbs = filename:absname(OutDir), Files = get_files([SrcDirAbs]), lists:foreach( fun(F) -> file(F, OutDirAbs) end, Files). file([SrcDir, OutDir]) -> SrcFilAbs = filename:absname(SrcDir), OutDirAbs = filename:absname(OutDir), file(SrcFilAbs, OutDirAbs). file(SrcFile, OutDir) -> case {filename:extension(SrcFile), filename:basename(SrcFile)} of %% The file must by *.erl, and the first character must be a-z {".erl", [FirstChar | _]} when (FirstChar >= 97) and (FirstChar =< 122) -> make_file(SrcFile, OutDir), d(); _ -> ok end. get_files([]) -> []; get_files([FHead | FTail]) -> case catch file:list_dir(FHead) of {ok, Files} -> FilesHead = [filename:join(FHead, FilesN) || FilesN <- Files], get_files(FilesHead ++ FTail); {error, enotdir} -> [FHead] ++ get_files(FTail) end. make_file(File, OutDir) -> FB = filename:basename(File), FileDot = filename:join(OutDir, FB ++ ".dot"), Text = gc(File), {ok,FO}=file:open(FileDot,[write]), try io:fwrite(FO,"~s",[Text]) after file:close(FO) end, FileSvg = filename:join(OutDir, filename:basename(File, ".erl") ++ ".svg"), case os:cmd("dot -Tsvg " ++ FileDot ++ " -o " ++ FileSvg) of "" -> ok; ShellResult -> io:format("Trying to run 'dot', we got this result:~n ~s~n" "Remember that you need to have Graphviz 'dot' installed.~n", [ShellResult]) end, ok. %%==================================================================== %% Internal functions %%==================================================================== g() -> g("a.erl"). g(Filename) -> gc(Filename), halt(). gc() -> gc("a.erl"). gc(Filename) -> {ok, File} = epp_dodger:parse_file(Filename), ets:new(arcs, [set, public, named_table, {keypos, 2}]), ets:new(mfa_conversion, [set, public, named_table, {keypos, 1}]), ets:new(counters, [set, public, named_table]), ets:insert(counters, {arcs_id, 0}), ModuleName = get_module_name(File), Exports = lists:usort(get_exports(File)), Functions = get_functions(File), FunctionsParsed = lists:usort(parse_functions(Functions)), % side effects: stores on ets Privates = FunctionsParsed -- Exports, %%Externals = get_externals(), MFAs = get_func_calls(), AppModules1 = os:cmd("ls -1 ../doc/devdoc/*.html | tr \".\" \" \" | tr \"/\" \" \" | awk '{print $3}'"), AppModules = [list_to_atom(Str) || Str <- string:tokens(AppModules1, [10])], ExternalTypes1 = [mfa_to_externaltype(MFA, ModuleName, AppModules, FunctionsParsed) || MFA <- MFAs], ExternalTypes = lists:usort(ExternalTypes1), AppExternals = [Function || {Type, Function} <- ExternalTypes, Type == app], ExmppExternals = [Function || {Type, Function} <- ExternalTypes, Type == exmpp], OTPExternals = [Function || {Type, Function} <- ExternalTypes, Type == other], textize(ModuleName, Exports, Privates, AppExternals, ExmppExternals, OTPExternals). get_arcs_id() -> ets:update_counter(counters, arcs_id, 1). insert_arc_normal(FromFunc, FromArity, ToFunc, ToArity) -> From = #mfa{mod = -1, func = FromFunc, arity = FromArity}, To = #mfa{mod = -1, func = ToFunc, arity = ToArity}, insert_arc(From, To). insert_arc_external(FromFunc, FromArity, ToMod, ToFunc, ToArity) -> From = #mfa{mod = -1, func = FromFunc, arity = FromArity}, To = #mfa{mod = ToMod, func = ToFunc, arity = ToArity}, insert_arc(From, To). insert_arc(From, To) -> Match = #arcs{ from = From, to = To, id='$1', _='_'}, Select = [{Match, [], ['$1']}], Ids = ets:select(arcs, Select), case Ids of [] -> ets:insert(arcs, #arcs{ id = get_arcs_id(), from = From, to = To, occ = 1 } ); [Id] -> [Arc] = ets:lookup(arcs, Id), Arc2 = Arc#arcs{occ = Arc#arcs.occ+1}, ets:insert(arcs, Arc2) end. read_arc(Id) -> ets:lookup(arcs, Id). d() -> ets:delete(arcs), ets:delete(mfa_conversion), ets:delete(counters). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Get %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_module_name(File) -> Attributes = get_elements(attribute, File), get_attribute(module, Attributes). get_exports(File) -> Attributes = get_elements(attribute, File), Exports = get_attribute(export, Attributes), parse_export(Exports). get_functions(File) -> get_elements(function, File). get_elements(Type, L) -> get_elements(Type, L, []). get_elements(_, [], Res) -> Res; get_elements(Type, [{tree, Type, _, A} | L], Res) -> get_elements(Type, L, Res++[A]); get_elements(Type, [_ | L], Res) -> get_elements(Type, L, Res). get_attribute(_, []) -> []; get_attribute(Name, [{attribute, {tree, atom, _, Name}, [Al]} | As]) -> case Name of module -> {tree, atom, _, Mn} = Al, Mn; export -> {tree, list, _, {list, Exports, _}} = Al, Exports++get_attribute(Name, As); _ -> ok end; get_attribute(Name, [_ | As]) -> get_attribute(Name, As). parse_export(Ex) -> lists:foldl( fun(Aq, Res) -> {tree, arity_qualifier, _, {arity_qualifier, Atom, Inte}} = Aq, {tree, atom, _, An} = Atom, {tree, integer, _, In} = Inte, Res++[{An, In}] end, [], Ex). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Parse %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% parse_functions(Functions) -> lists:map( fun(E) -> {function, {_, _, _, Fn}, Clauses} = E, Arity = get_function_arity(Clauses), parse_clauses(Fn, Clauses), {Fn, Arity} end, Functions). parse_clauses(Fn, Clauses) -> lists:foreach( fun(E) -> {tree, clause, L, C} = E, {attr, _Ln, _, _} = L, {clause, Parameters, _, Contents} = C, Fa = length(Parameters), parse_contents({Fn, Fa}, Contents) end, Clauses). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% OLD %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% parse_contents(F, Contents) -> {_, Res} = lists:foldl( fun(C, {Fu, R}) -> {Fu, R++parse_content(F, C)} end, {F, []}, Contents), Res. parse_content(F, {tree, application, L, A}) -> {attr, _Ln, _, _} = L, parse_application(F, A); parse_content(F, {tree, list, _, {list, [L], Ls}}) -> RL = parse_content(F, L), RL++parse_content(F, Ls); parse_content(F, {tree, tuple, _, T}) -> parse_contents(F, T); parse_content(F, {tree, match_expr, _, M}) -> {match_expr, _, Value} = M, parse_content(F, Value); parse_content(F, {tree, try_expr, _, T}) -> {try_expr, As, Bs, Cs, Ds} = T, RAs = parse_contents(F, As), RBs = parse_contents(F, Bs), RDs = parse_contents(F, Ds), RAs++RBs++RDs++parse_contents(F, Cs); parse_content(F, {tree, block_expr, _, Ts}) -> parse_contents(F, Ts); parse_content(F, {tree, catch_expr, _, C}) -> parse_content(F, C); parse_content(F, {tree, case_expr, _, C}) -> {case_expr, Case, Cases} = C, R2 = parse_content(F, Case), R2++parse_contents(F, Cases); parse_content(F, {tree, if_expr, _, Cases}) -> parse_contents(F, Cases); parse_content(F, {tree, disjunction, _, Cases}) -> parse_contents(F, Cases); parse_content(F, {tree, conjunction, _, Cases}) -> parse_contents(F, Cases); parse_content(F, {tree, list_comp, _, L}) -> {list_comp, A, Bs} = L, RA = parse_content(F, A), RA++parse_contents(F, Bs); parse_content(F, {tree, generator, _, G}) -> {generator, _, Gen} = G, parse_content(F, Gen); parse_content(F, {tree, clause, _, C}) -> {clause, Clause, When, Second} = C, R2 = parse_contents(F, Clause), R3 = parse_content(F, When), R2++R3++parse_contents(F, Second); parse_content(F, {tree, fun_expr, _, E}) -> parse_contents(F, E); parse_content(F, {tree, record_expr, _, E}) -> {record_expr, _, _, Records} = E, parse_contents(F, Records); parse_content(F, {tree, record_field, _, R}) -> {record_field, F1, F2} = R, R2 = parse_content(F, F1), R2++parse_content(F, F2); parse_content(F, {tree, receive_expr, _, E}) -> {receive_expr, E1, _, _} = E, parse_contents(F, E1); parse_content(F, {tree, infix_expr, _, I}) -> {infix_expr, _Operator, T1, T2} = I, R = parse_content(F, T1), R++parse_content(F, T2); parse_content(_F, {tree, prefix_expr, _, _P}) -> []; parse_content(_F, {tree, class_qualifier, _, _}) -> []; parse_content(_F, {tree, implicit_fun, _, _}) -> []; parse_content(_F, {tree, record_access, _, _}) -> []; parse_content(_F, {tree, record_index_expr, _, _}) -> []; parse_content(_F, {tree, macro, _, _}) -> []; parse_content(_F, {tree, binary, _, _}) -> []; parse_content(_F, {tree, binary_generator, _, _}) -> []; parse_content(_F, {tree, binary_comp, _, _}) -> []; parse_content(_F, {integer, _, _I}) -> []; parse_content(_F, {float, _, _I}) -> []; parse_content(_F, {string, _, _S}) -> []; parse_content(_F, {char, _, _S}) -> []; parse_content(_F, {atom, _, _A}) -> []; parse_content(_F, {var, _, _V}) -> []; parse_content(_F, {nil, _}) -> []; parse_content(_F, none) -> []; parse_content(_F, C) -> io:format("Unknown content: ~p~n", [C]), []. parse_application({Fn, Fa}, {application, {atom, _, Name}, Valores}) -> Arity = length(Valores), insert_arc_normal(Fn, Fa, Name, Arity), Ra = [{arc_normal, Fn, Name}], Ra++parse_contents({Fn, Fa}, Valores); parse_application({Fn, Fa}, {application, {tree, module_qualifier, _, M}, Tree2}) -> case M of {module_qualifier, {_, _, Tf1}, {_, _, Tf2}} -> ToArity = length(Tree2), insert_arc_external(Fn, Fa, Tf1, Tf2, ToArity), parse_contents({Fn, Fa}, Tree2); _Other -> %%io:format("Unknown application module_qualifier: ~p~n", [M]), parse_contents({Fn, Fa}, Tree2) end; parse_application({Fn, Fa}, {application, {tree, record_access, _, _}, Tree2}) -> parse_contents({Fn, Fa}, Tree2); parse_application({Fn, Fa}, {application, {var, _, _}, Tree2}) -> parse_contents({Fn, Fa}, Tree2); parse_application({Fn, Fa}, {application, Other, Tree2}) -> io:format("Unknown application tree: ~p~n", [Other]), parse_contents({Fn, Fa}, Tree2). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Textize %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% textize(ModuleName, Exports, Privates, AppExternals, ExmppExternals, OTPExternals) -> ExportsS = textize_exports(Exports), PrivatesS = textize_exports(Privates), AppExternalsS = textize_externals(AppExternals), ExmppExternalsS = textize_externals(ExmppExternals), OTPExternalsS = textize_externals(OTPExternals), Arcs = textize_arcs(), io_lib:format( "digraph ~p {~n"++ " label = \"Module ~p\";~n"++ " labelloc = \"t\";~n"++ " fontname = Helvetica;~n"++ " rankdir = LR;~n"++ " ratio = fill;~n"++ %%" node [shape = box, style = filled, color = olivedrab1, fontsize=40];~s~n"++ %%" node [shape = parallelogram, style = filled, color = rosybrown1, fontsize=40];~s~n"++ %%" node [shape = ellipse, style = filled, color = slategray1, peripheries=3, fontsize=40];~n"++ " node [shape = box, color=darkgreen, fillcolor=Honeydew, style=filled, href=\"PRI~p.html#\\N\"];~s~n"++ " node [shape = box, color=darkgreen, fillcolor=PaleGreen, style=filled, href=\"EXP~p.html#\\N\"];~s~n"++ " node [shape = box, color=darkgreen, fillcolor=Aquamarine, style=filled, href=\"APP\\N\"];~s~n"++ " node [shape = box, color=darkblue, fillcolor=LightSkyBlue,style=filled, href=\"EXM\\N\"];~s~n"++ " node [shape = box, color=darkred, fillcolor=PeachPuff, style=filled, href=\"OTP\\N\"];~s~n"++ " node [shape = box];~n"++ "~s"++ "}~n", [ModuleName, ModuleName, ModuleName, PrivatesS, ModuleName, ExportsS, AppExternalsS, ExmppExternalsS, OTPExternalsS, Arcs]). textize_exports(Exports) -> lists:foldl( fun({Func, Arity}, R) -> string:concat(R, io_lib:format(" \"~p/~p\";", [Func, Arity])) end, "", Exports). textize_externals(Externals) -> lists:foldl( fun({Mod, Func, Arity}, R) -> string:concat(R, io_lib:format(" \"~p:~p/~p\";", [Mod, Func, Arity])); ({Func, Arity}, R) -> string:concat(R, io_lib:format(" \"~p/~p\";", [Func, Arity])) end, "", Externals). textize_arcs() -> Id = ets:first(arcs), textize_arcs(Id, []). textize_arcs('$end_of_table', Res) -> Res; textize_arcs(Id, Res) -> [Arc] = read_arc(Id), From = mfa_prepare(Arc#arcs.from), To = mfa_prepare(Arc#arcs.to), Edge_attrs = check_loop(From, To)++check_occu(Arc#arcs.occ)++check_external(Arc#arcs.to), Res2 = io_lib:format(" ~s -> ~s~s;~n", [From, To, Edge_attrs]), Id_next = ets:next(arcs, Id), textize_arcs(Id_next, string:concat(Res2, Res)). get_func_calls() -> Id = ets:first(arcs), get_func_calls(Id, []). get_func_calls('$end_of_table', Res) -> Res; get_func_calls(Id, Res) -> [Arc] = read_arc(Id), MFA = Arc#arcs.to, Call = MFA, Id_next = ets:next(arcs, Id), get_func_calls(Id_next, [Call | Res]). mfa_prepare(MFAinitial) -> MFA = try_mfa_conversion(MFAinitial), Mod = case MFA#mfa.mod of -1 -> "\""; M -> io_lib:format("\"~p:", [M]) end, Func = io_lib:format("~p", [MFA#mfa.func]), Arity = case MFA#mfa.arity of -1 -> "\""; A -> io_lib:format("/~p\"", [A]) end, string:concat(Mod, string:concat(Func, Arity)). %% noexternal | app | exmpp | other mfa_to_externaltype(MFA, ModuleName, AppModules, Functions) -> case MFA of {mfa, -1, Fu, Ar} -> case {is_internal, lists:member({Fu, Ar}, Functions)} of {is_internal, true} -> {noexternal, {Fu, Ar}}; {is_internal, false} -> store_mfa_conversion(MFA, {mfa, -1, Fu, Ar}), {other, {Fu, Ar}} end; {mfa, Mo, Fu, Ar} when Mo == ModuleName -> store_mfa_conversion(MFA, {mfa, -1, Fu, Ar}), {noexternal, {Fu, Ar}}; {mfa, Mo, Fu, Ar} -> Type = case {is_app, lists:member(Mo, AppModules)} of {is_app, true} -> app; {is_app, false} -> case string:str(atom_to_list(Mo), "exmpp") of 0 -> other; N when is_integer(N) -> exmpp end end, {Type, {Mo, Fu, Ar}} end. get_function_arity([{tree, clause, _, {clause, Vars, _, _}} | _]) -> length(Vars); get_function_arity(E) -> io:format("Unknown function arity: ~p~n", [E]). store_mfa_conversion(MFA1, MFA2) -> ets:insert(mfa_conversion, {MFA1, MFA2}). try_mfa_conversion(MFA) -> case ets:lookup(mfa_conversion, MFA) of [{MFA,MFA2}] -> MFA2; [] -> MFA end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utils %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%check_loop(I, I) -> " [color = sandybrown]"; check_loop(I, I) -> ""; check_loop(_, _) -> "". check_occu(1) -> ""; check_occu(Occ) -> io_lib:format(" [label=\"~p\"]", [Occ]). check_external(To) -> case To#mfa.mod of -1 -> " [style = bold]"; _ -> "" end.