%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.0, (the "License"); you may not use this file except in
%% compliance with the License. You may obtain a copy of the License at
%% http://www.erlang.org/EPL1_0.txt
%% 
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%% 
%% The Original Code is Erlang-4.7.3, December, 1998.
%% 
%% The Initial Developer of the Original Code is Ericsson Telecom
%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%% Telecom AB. All Rights Reserved.
%% 
%% Contributor(s): ______________________________________.''
%%
%% Copyright (C) 1991, Ellemtel Telecommunications Systems Laboratories
%% File	   : c.erl
%% Author  : Joe Armstrong, Robert Virding, Claes Wikstrom
%% Purpose : Utilities to use from shell.

-module(c).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/1').

-export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,ni/0,
	 i/3,pid/3,m/0,m/1,
	 erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0,
	 nregs/0,pwd/0,ls/0,ls/1,cd/1]).

-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysearch/3,keysort/2,
		concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2,map/2]).
-import(io, [format/1, format/2]).

help() ->
    format('c(File)    -- compile and load code in <File>~n'),
    format('cd(Dir)    -- cd Dir .. example cd("..")~n'),
    format('flush()    -- flush any messages sent to the shell~n'),
    format('help()     -- help info~n'),
    format('i()        -- information about the system~n'),
    format('ni()       -- information about the networked system~n'),
    format('i(X,Y,Z)   -- information about pid <X,Y,Z>~n'),
    format('l(Module)  -- load or reload module~n'),
    format('lc([File]) -- compile a list of Erlang modules~n'),
    format('ls()       -- list files in the current directory~n'),
    format('ls(Dir)    -- list files in directory <Dir>~n'),
    format('m()        -- which modules are loaded~n'),
    format('m(Mod)     -- information about module <Mod>~n'),
    format('nc(File)   -- compile and load code in <File> on all nodes~n'),
    format('nl(Module) -- load module on all nodes~n'),
    format('pid(X,Y,Z) -- convert X,Y,Z to a Pid~n'),
    format('pwd()      -- print working directory~n'),
    format('regs()     -- information about registered processes~n'),
    format('nregs()    -- information about all registered processes~n').

%% c(FileName)
%%  Compile a file/module.

c(File) -> c(File, []).

c(File, Opt) when atom(Opt) -> c(File, [Opt]);
c(File, Opts0) ->
    Opts = Opts0 ++ [report_errors, report_warnings],
    case code:interpreted(File) of
	false ->
	    case compile:file(File, Opts) of
		{ok,Mod} ->
		    machine_load(Mod,File,Opts);
		{ok,Mod,Ws} ->			%Warnings maybe turned on!
		    machine_load(Mod,File,Opts);
		Other ->			%Errors go here
		    Other
	    end;
	true ->
	    format("*** Warning: Module ~p is interpreted.~n",[File]),
	    format("             No object file will be created.~n"),
	    int:i(File,Opts)
    end.


%%% Obtain the 'outdir' option from the argument. Return "." if no
%%% such option was given.
outdir([]) ->
    ".";
outdir([Opt|Rest]) ->
    case Opt of
	{outdir, D} ->
	    D;
	_ ->
	    outdir(Rest)
    end.

%%% We have compiled File with options Opts. Find out where the
%%% output file went to, and load it.
machine_load(Mod,File,Opts) ->
    Dir = outdir(Opts),
    File2 = filename:join([Dir,filename:basename(File, ".erl")]),
    machine_load(Mod,File2).

machine_load(Mod,File) ->
    {Dir, Base} = compile:iofile(File),
    Mod0 = atom_to_list(Mod),
    if
	Base == Mod0 ->
	    code:purge(Mod),
	    check_load(code:load_abs(File), Mod);
	true ->
	    format("** Module name does not match file name in ~s.erl **~n",[Base]),
	    {error, badfile}
    end.

%%% This function previously warned if the loaded module was
%%% loaded from some other place than current directory.
%%% Now, loading from other than current directory is supposed to work.
%%% so this function always reports success.
check_load(_, X) -> {ok, X}.

%% Compile a list of modules
%% enables the nice unix shell cmd
%% erl -s c lc f1 f2 f3 @d c1=v1 @c2 @i IDir @o ODir -s erlang halt
%% to compile files f1.erl , f2.erl ....... from a unix shell
%% with constant c2 defined, c1=v1 (v1 must be a term!), include dir
%% IDir, outdir ODir.

lc(Args) ->
    case catch split(Args, [], []) of
	error -> error;
	{Opts, Files} ->
	    COpts = [report_errors, report_warnings | reverse(Opts)],
	    foreach(fun(File) -> compile:file(File, COpts) end, reverse(Files))
    end.

split(['@i', Dir | T], Opts, Files) ->
    split(T, [{i, atom_to_list(Dir)} | Opts], Files);
split(['@o', Dir | T], Opts, Files) ->
    split(T, [{outdir, atom_to_list(Dir)} | Opts], Files);
split(['@d', Def | T], Opts, Files) ->
    split(T, [split_def(atom_to_list(Def), []) | Opts], Files);
split([File | T], Opts, Files) ->
    split(T, Opts, [File | Files]);
split([], Opts, Files) ->
    {Opts, Files}.

split_def([$= | T], Res) -> {d, list_to_atom(reverse(Res)),make_term(T)};
split_def([H | T], Res) -> split_def(T, [H | Res]);
split_def([], Res) -> {d, list_to_atom(reverse(Res))}.

make_term(Str) ->
    case erl_scan:string(Str) of
	{ok, Tokens, _} ->
	    case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
		{ok, Term} -> Term;
		{error, {_,_,Reason}} ->
		    io:format("~s: ~s~n", [Reason, Str]),
		    throw(error)
	    end;
	{error, {_,_,Reason}, _} ->
	    io:format("~s: ~s~n", [Reason, Str]),
	    throw(error)
    end.

nc(File) -> nc(File, []).

nc(File, Opt) when atom(Opt) -> nc(File, [Opt]);
nc(File, Opts0) ->
    Opts = Opts0 ++ [report_errors, report_warnings],
    case code:interpreted(File) of
	false ->
	    case compile:file(File, Opts) of
		{ok,Mod} ->
		    Fname = concat([File, code:objfile_extension()]),
		    case file:read_file(Fname) of
			{ok,Bin} ->
			    rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]),
			    {ok,Mod};
			Other ->
			    Other
		    end;
		Other ->                                %Errors go here
		    Other
	    end;
	_ ->
	    format("*** Warning: Module ~p is interpreted.~n",[File]),
	    format("             No object file will be created.~n"),
	    int:ni(File,Opts)
    end.

%% l(Mod)
%%  Reload module Mod from file of same name

l(Mod) ->
    code:purge(Mod),
    code:load_file(Mod).

%% Network version of l/1
nl(Mod) ->
    case code:get_object_code(Mod) of
	{Module, Bin, Fname} ->
            rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]);
	Other ->
	    Other
    end.

i() -> i(processes()).
ni() -> i(all_procs()).

i(Ps) ->
    iformat("Pid", "Initial Call", "Current Function", "Reds", "Msgs"),
    {R,M} = foldl(fun display_info/2, {0,0}, Ps),
    iformat("Total", "", "", io_lib:write(R), io_lib:write(M)).

display_info(Pid, {R,M}) ->
    case pinfo(Pid) of
	undefined -> {R,M};
	Info ->
	    Call = initial_call(Info),
	    Curr = case fetch(current_function, Info) of
		       {Mod,F,Args} when list(Args) ->
			   {Mod,F,length(Args)};
		       Other ->
			   Other
		   end,
	    Reds  = fetch(reductions, Info),
	    LM = length(fetch(messages, Info)),
	    iformat(io_lib:write(Pid), io_lib:write(Call),
		    io_lib:write(Curr), io_lib:write(Reds), io_lib:write(LM)),
	    {R+Reds,M+LM}
    end.

%% We have to do some assumptions about the initial call.
%% If the initial call is proc_lib:init_p/5 we can find more information
%% calling the function proc_lib:initial_call/1.

initial_call(Info)  ->
    case fetch(initial_call, Info) of
	{proc_lib, init_p, 5} ->
	    proc_lib:translate_initial_call(Info);
	ICall ->
	    ICall
    end.

iformat(A1, A2, A3, A4, A5) ->
    format("~-12s ~-23s ~-23s ~12s ~4s~n", [A1,A2,A3,A4,A5]).

all_procs() ->
    case is_alive() of
	true -> flatmap(fun (N) -> rpc:call(N,erlang,processes,[]) end,
			[node()|nodes()]);
	false -> processes()
    end.

pinfo(Pid) ->
    case is_alive() of
	true -> rpc:call(node(Pid), erlang, process_info, [Pid]);
	false -> process_info(Pid)
    end.

fetch(Key, Info) ->
    case keysearch(Key, 1, Info) of
	{value, {_, Val}} -> Val;
	false -> 0
    end.

pid(X,Y,Z) ->
    list_to_pid("<" ++ integer_to_list(X) ++ "." ++
		integer_to_list(Y) ++ "." ++
		integer_to_list(Z) ++ ">").

i(X,Y,Z) -> pinfo(pid(X,Y,Z)).

m() ->
    mformat("Module", "File"),
    {ok,Cwd} = file:get_cwd(),
    foreach(fun ({Mod,File0}) ->
		    File = relative_name(Mod,File0,Cwd),
		    mformat(Mod, File)
	    end,
	    sort(code:all_loaded())).

relative_name(Mod, File) ->
    {ok, Cwd} = file:get_cwd(),
    Cwd2 = filename:join([Cwd]), % to normalise
    relative_name(Mod, File, Cwd2).

relative_name(Mod, File, Cwd) ->
    case code:rel_loaded_p(Mod) of
	false ->
	    File;
	_ ->
	    case lists:prefix(Cwd, File) of
		false -> File;
		_     -> strip_cwd(File, Cwd)
	    end
    end.

strip_cwd(File0, Cwd) ->
    I = length(Cwd),
    L = length(File0),
    File1 = lists:sublist(File0,I+2,L),
    case filename:split(File1) of
	["."|T]  -> filename:join(["."|T]);
	[".."|T] -> filename:join([".."|T]);
	_        -> filename:join(".",File1)
    end.

mformat(A1, A2) ->
    format("~-20s  ~s\n", [A1,A2]).

%% erlangrc(Home)
%%  Try to run a ".erlang" file, first in the current directory
%%  else in home directory.

erlangrc() ->
    case init:get_argument(home) of
	{ok,[[Home]]} ->
	    erlangrc([Home]);
	_ ->
	    file:path_eval(["."], ".erlang")
    end.

erlangrc([Home]) ->
    file:path_eval([".",Home], ".erlang").

bi(I) ->
    case erlang:info(I) of
	X when binary(X) -> io:put_chars(binary_to_list(X));
	X when list(X) -> io:put_chars(X);
	X -> format("~w", [X])
    end.

%%
%% Short and nice form of module info
%%

m(M) ->
    L = M:module_info(),
    {value,{exports,E}} = keysearch(exports, 1, L),
    Time = get_compile_time(L),
    Srcfile = get_src_file(L),
    COpts = get_compile_options(L),
    format("Module ~w compiled: ",[M]), print_time(Time),
    format("Compiler options:  ~p~n", [COpts]),
    format("Sourcefile:  ~s~n", [Srcfile]),
    print_object_file(M),
    format("Exports: ~n",[]), print_exports(keysort(1, E)).

print_object_file(Mod) ->
    case code:is_loaded(Mod) of
	{file,File0} ->
	    File = relative_name(Mod,File0),
	    format("Objectfile:  ~s~n",[File]);
	_ ->
	    ignore
    end.

get_compile_time(L) ->
    case get_compile_info(L, time, compiletime) of
	{ok,Val} -> Val;
	error -> notime
    end.

get_compile_options(L) ->
    case get_compile_info(L, options, compiler_options) of
	{ok,Val} -> Val;
	error -> []
    end.

get_src_file(L) ->
    case get_compile_info(L, source_file, source_file) of
	{ok,Val} -> Val;
	error -> "No source file info available"
    end.

get_compile_info(L, Tag, OldTag) ->
    case keysearch(compile, 1, L) of
	{value, {compile, I}} ->
	    case keysearch(Tag, 1, I) of
		{value, {Tag, Val}} -> {ok,Val};
		false -> error
	    end;
	false ->
	    case keysearch(OldTag, 1, L) of
		{value, {OldTag, Val}} -> {ok,Val};
		false -> error
	    end
    end.

print_exports(X) when length(X) > 16 ->
    split_print_exports(X);
print_exports([]) -> ok;
print_exports([{F, A} |Tail]) ->
    format("         ~w/~w~n",[F, A]),
    print_exports(Tail).

split_print_exports(L) ->
    Len = length(L),
    Mid = Len div 2,
    L1 = sublist(L, 1, Mid),
    L2 = sublist(L, Mid +1, Len - Mid + 1),
    split_print_exports(L1, L2).

split_print_exports([], [{F, A}|T]) ->
    Str = " ",
    format("~-30s~w/~w~n", [Str, F, A]),
    split_print_exports([], T);
split_print_exports([{F1, A1}|T1], [{F2, A2} | T2]) ->
    Str = flatten(io_lib:format("~w/~w", [F1, A1])),
    format("~-30s~w/~w~n", [Str, F2, A2]),
    split_print_exports(T1, T2);
split_print_exports([], []) -> ok.

print_time({Year,Month,Day,Hour,Min,Secs}) ->
    format("Date: ~s ~w ~w, ", [month(Month),Day,Year]),
    format("Time: ~.2.0w.~.2.0w~n", [Hour,Min]);
print_time(notime) ->
    format("No compile time info available~n",[]).

month(1) -> "January";
month(2) -> "February";
month(3) -> "March";
month(4) -> "April";
month(5) -> "May";
month(6) -> "June";
month(7) -> "July";
month(8) -> "August";
month(9) -> "September";
month(10) -> "October";
month(11) -> "November";
month(12) -> "December".

%% Just because we can't eval receive statements...
flush() ->
    receive
	X ->
	    format("Shell got ~p~n",[X]),
	    flush()
    after 0 ->
	    ok
    end.

%% Print formated info about all registered processes in the system
nregs() ->
    foreach(fun (N) -> print_node_regs(N) end, all_regs()).

regs() ->
    print_node_regs({node(),registered()}).

all_regs() ->
    case is_alive() of
	true -> map(fun (N) -> {N,rpc:call(N, erlang, registered, [])} end,
		    [node()|nodes()]);
	false -> [{node(),registered()}]
    end.

print_node_regs({N, List}) when list(List) ->
    format("~n** Registered procs on node ~w **~n",[N]),
    rformat("Name", "Pid", "Initial Call", "Reds", "Msgs"),
    foreach(fun (Name) -> display_name_info(N, Name) end, sort(List)).

display_name_info(Node, Name) ->
    case pwhereis(Node, Name) of
	undefined ->
	    pline(Name, undefined, undefined);
	Pid ->
	    pline(Name, pinfo(Pid), Pid)
    end.

pwhereis(Node, Name) ->
    case is_alive() of
	true -> rpc:call(Node, erlang, whereis, [Name]);
	false -> whereis(Name)
    end.

pline(Name, undefined, Pid) ->		%Process has died
    rformat(Name, Pid, "dead", 0, 0);
pline(Name, Info, Pid) ->
    Call = initial_call(Info),
    Reds  = fetch(reductions, Info),
    LM = length(fetch(messages, Info)),
    rformat(io_lib:format("~w",[Name]),
	    io_lib:format("~w",[Pid]),
	    io_lib:format("~w",[Call]),
	    integer_to_list(Reds), integer_to_list(LM)).

rformat(Name, Pid, Call, Reds, LM) ->
    format("~-21s ~-12s ~-25s ~12s ~4s~n", [Name,Pid,Call,Reds,LM]).

%% pwd()
%% cd(Directory)
%%  These are just wrappers around the file:get/set_cwd functions.

pwd() ->
    {ok,Str} = file:get_cwd(),
    format("~s\n",[Str]).

cd(Dir) ->
    file:set_cwd(Dir),
    pwd().

%% ls()
%% ls(Directory)
%%  The strategy is to print in fixed width files.

ls() ->
    ls(".").

ls(Dir) ->
    case file:list_dir(Dir) of
	{ok, Entries} ->
	    ls_print(sort(Entries));
	{error,E} ->
	    format("Invalid directory\n")
    end.

ls_print([]) -> ok;
ls_print(L) ->
    Width = min([max(lengths(L, [])), 40]) + 5,
    ls_print(L, Width, 0).

ls_print(X, Width, Len) when Width + Len > 80 ->
    io:nl(),
    ls_print(X, Width, 0);
ls_print([H|T], Width, Len) ->
    io:format("~-*s",[Width,H]),
    ls_print(T, Width, Len+Width);
ls_print([], _, _) ->
    io:nl().

lengths([H|T], L) -> lengths(T, [length(H)|L]);
lengths([], L)    -> L.

