%% ``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): ______________________________________.''
%%
%% (location transparent) interface to the Term store BIF's
%% Author klacke@erix.ericsson.se

%% ets == Erlang Term Store

%% Modified 1997-05-30 by Magnus Froberg, magnus@erix.ericsson.se
%% Changed the table identifier to {Id, self()}.
%% This was due to malfunctioning if a table was created before the
%% node is made alive. Such a table couldn't be accessed after the node
%% was made alive. (Before the table id. was {Id, node()})

-module(ets).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/1').
-export([all/0,
	 delete/1,
	 delete/2,
	 file2tab/1,
	 filter/3,
	 first/1,
	 fixtable/2,
	 info/1,
	 info/2,
	 insert/2,
	 lookup/2,
	 lookup_element/3,
	 match/2,
	 match_delete/2,
	 match_object/2,
	 new/2,
	 next/2,
	 slot/2,
	 tab2file/2,
	 tab2list/1,
	 update_counter/3]).

-export([i/0, i/1, i/2, i/3]).

%% local exports
-export([to_string/1, prinfo/1]).

lookup(T,K) when atom(T) ->
    erlang:db_get(T,K);
lookup(T,K) when integer(T) ->
    erlang:db_get(T,K);
lookup({T,Pid},K) when node(Pid) == node() ->         
    erlang:db_get(T,K);
lookup({T,Pid},K)  ->         
    chk(rpc:block_call(node(Pid), ets, lookup, [T, K])).

lookup_element(T,K,Pos) when atom(T) ->
    erlang:db_get_element(T,K,Pos);
lookup_element(T,K,Pos) when integer(T) ->
    erlang:db_get_element(T,K,Pos);
lookup_element({T,Pid},K,Pos) when node(Pid) == node() ->         
    erlang:db_get_element(T,K,Pos);
lookup_element({T,Pid},K,Pos)  ->         
    chk(rpc:block_call(node(Pid), ets, lookup_element, [T, K,Pos])).

insert(T,V) when atom(T) ->
    erlang:db_put(T,V);
insert(T,V) when integer(T) ->
    erlang:db_put(T,V);
insert({T, Pid},V) when node(Pid) == node() ->
    erlang:db_put(T,V);
insert({T, Pid},V)  ->
    chk(rpc:block_call(node(Pid), ets, insert, [T,V])).

delete(T,K) when atom(T) ->
    erlang:db_erase(T,K);
delete(T,K) when integer(T) ->
    erlang:db_erase(T,K);
delete({T, Pid},K) when node(Pid) == node() ->
    erlang:db_erase(T,K);
delete({T, Pid},K)  ->
     chk(rpc:block_call(node(Pid), ets, delete, [T,K])).

delete(T) when atom(T) ->      
    erlang:db_erase(T);
delete(T) when integer(T) ->      
    erlang:db_erase(T);
delete({T, Pid}) when node(Pid) == node() ->      
    erlang:db_erase(T);
delete({T, Pid})  ->      
    chk(rpc:block_call(node(Pid), ets, delete, [T])).

first(T) when atom(T) -> 
    erlang:db_first(T);
first(T) when integer(T) -> 
    erlang:db_first(T);
first({T, Pid}) when node(Pid) == node() -> 
    erlang:db_first(T);
first({T, Pid})  -> 
    chk(rpc:block_call(node(Pid), ets, first, [T])).


fixtable(T, How) when atom(T) -> 
    erlang:db_fixtable(T, How);
fixtable(T, How) when integer(T) -> 
    erlang:db_fixtable(T, How);
fixtable({T, Pid}, How) when node(Pid) == node() -> 
    erlang:db_fixtable(T, How);
fixtable({T, Pid}, How)  -> 
    chk(rpc:block_call(node(Pid), ets, fixtable, [T, How])).


next(T,K) when atom(T) ->
    erlang:db_next_key(T,K);
next(T,K) when integer(T) ->
    erlang:db_next_key(T,K);
next({T, Pid},K) when node(Pid) == node() ->
    erlang:db_next_key(T,K);
next({T, Pid},K)  ->
    chk(rpc:block_call(node(Pid), ets, next, [T, K])).


slot(T,Slot) when atom(T) ->
    erlang:db_slot(T,Slot);
slot(T,Slot) when integer(T) ->
    erlang:db_slot(T,Slot);
slot({T, Pid},Slot) when node(Pid) == node() ->
    erlang:db_slot(T,Slot);
slot({T, Pid},Slot)  ->
    chk(rpc:block_call(node(Pid), ets, slot, [T, Slot])).

new(Name, Type) ->     {erlang:db_create(Name, Type), self()}.
all() ->               add_owner(erlang:db_all_tables(), []).

add_owner([H|T], Ack) ->
    case info(H, owner) of
	undefined ->				% it may have died while
	    add_owner(T, Ack);			% we were collecting it
	Info ->
	    add_owner(T, [{H, Info} | Ack])
    end;
add_owner([], Ack) ->
    Ack.

match(T,Pattern) when atom(T) ->
    erlang:db_match(T,Pattern);
match(T,Pattern) when integer(T) ->
    erlang:db_match(T,Pattern);
match({T, Pid},Pattern)   when node(Pid) == node() ->
    erlang:db_match(T,Pattern);
match({T, Pid},Pattern)   ->
    chk(rpc:block_call(node(Pid), ets, match, [T,Pattern])).

match_object(T,Pattern) when atom(T) ->
    erlang_db_match_object(T,Pattern);
match_object(T,Pattern) when integer(T) ->
    erlang_db_match_object(T,Pattern);
match_object({T, Pid},Pattern)   when node(Pid) == node() ->
    erlang_db_match_object(T,Pattern);
match_object({T, Pid},Pattern)   ->
    chk(rpc:block_call(node(Pid), ets, match_object, [T,Pattern])).

erlang_db_match_object(Tab, Pat) ->
    erlang_db_match_object(Tab, Pat, 1000).

erlang_db_match_object(Tab, Pat, State0) ->
    case erlang:db_match_object(Tab, Pat, State0) of
        State when tuple(State) ->
            receive
            after 1 -> % Makes sure that the process is scheduled out
                    erlang_db_match_object(Tab, Pat, State)
            end;
        Result when list(Result) ->
            Result
    end.

update_counter(T,Counter, Val) when atom(T) ->
    erlang:db_update_counter(T,Counter, Val);
update_counter(T,Counter, Val) when integer(T) ->
    erlang:db_update_counter(T,Counter, Val);
update_counter({T, Pid},Counter, Val)   when node(Pid) == node() ->
    erlang:db_update_counter(T,Counter, Val);
update_counter({T, Pid},Counter, Val)   ->
    chk(rpc:block_call(node(Pid), ets, update_counter, [T,Counter, Val])).


info(T) when atom(T) ->
    local_info(T, node());
info(T) when integer(T) ->
    local_info(T, node());
info({T, Pid}) when node(Pid) == node() ->
    local_info(T, node());
info({T, Pid}) ->
    chk(rpc:block_call(node(Pid), ets, info, [T])).

local_info(T, Node) ->
    case catch erlang:db_info(T, memory) of
	undefined -> undefined;
	{'EXIT', _} -> undefined;
	Mem ->
	    {{memory, Mem}, {owner, info(T, owner)}, 
	     {name,info(T, name)},
	     {size, info(T, size)}, {node, Node},
	     {named_table, info(T, named_table)},
	     {type, info(T, type)}, 
	     {keypos, info(T, keypos)},
	     {protection, info(T, protection)}}
    end.

info(T, What) when atom(T) -> 
    local_info(T, What, node());
info(T, What) when integer(T) ->
    local_info(T, What, node());
info({T, Pid}, What) when node(Pid) == node() -> 
    local_info(T, What, node());
info({T, Pid}, What) ->
    chk(rpc:block_call(node(Pid), ets, info, [T, What])).

local_info(T, What, Node) ->
    case What of 
	node ->
	    Node;
	named_table ->
	    if
		atom(T) -> true;
		true -> false
	    end;
	_ ->
	    case catch erlang:db_info(T, What) of
	        undefined -> undefined;
		{'EXIT',_} -> undefined;
		Result -> Result
	    end
    end.

match_delete(Tn, Pattern) when atom(Tn) ->
    erlang:db_match_erase(Tn,Pattern);
match_delete(Tn, Pattern) when integer(Tn) ->
    erlang:db_match_erase(Tn,Pattern);
match_delete({Tn, Pid}, Pattern) when node(Pid) == node() ->
    erlang:db_match_erase(Tn,Pattern);
match_delete({T, Pid}, Pattern) ->
    chk(rpc:call(node(Pid), ets , match_delete, [T, Pattern])).


%% Produce a list of {Key,Value} tuples from a table

tab2list(T) when atom(T) ->
    whole_tab(T, erlang:db_match(T, '$1'), []);
tab2list(T) when integer(T) ->
    whole_tab(T, erlang:db_match(T, '$1'), []);
tab2list({T,Pid}) when node(Pid) == node() ->
    whole_tab(T, erlang:db_match(T, '$1'), []);
tab2list({T,Pid}) ->
    chk(rpc:call(node(Pid), ets,tab2list, [T])).

whole_tab(Tab, [[X]|T], Ack) -> 
    whole_tab(Tab, T, [X|Ack]);
whole_tab(Tab, [], Ack) ->
    Ack.

filter(Tn, F, A) when atom(Tn) ->
    do_filter(Tn,erlang:db_first(Tn),F,A, []);
filter(Tn, F, A) when integer(Tn) ->
    do_filter(Tn,erlang:db_first(Tn),F,A, []);
filter({Tn, Pid}, F, A) when node(Pid) == node() ->
    do_filter(Tn,erlang:db_first(Tn),F,A, []);
filter({Tn, Pid}, F, A) -> 
    chk(rpc:call(node(Pid), ets, filter, [Tn, F, A])).

do_filter(Tab, '$end_of_table', _,_, Ack) -> 
    Ack;
do_filter(Tab, Key, F, A, Ack) ->
    case apply(F, [erlang:db_get(Tab, Key) | A]) of
	false ->
	    do_filter(Tab, erlang:db_next_key(Tab, Key), F,A,Ack);
	true ->
	    Ack2 = lists:append(erlang:db_get(Tab, Key), Ack),
	    do_filter(Tab, erlang:db_next_key(Tab, Key), F,A,Ack2);
	{true, Value} ->
	    do_filter(Tab, erlang:db_next_key(Tab, Key), F,A,[Value | Ack])
    end.

    
%% Dump a table to a file using the disk_log facility
tab2file({Tab, Pid}, File) when node() == node(Pid) ->
    tab2file(Tab, File);
tab2file(Tab, File) ->
    file:delete(File),
    Name = make_ref(),
    case {disk_log:open([{name, Name}, {file, File}]),
	  local_info(Tab, node())} of
	{{ok, Name}, undefined} ->
	    disk_log:close(Name),
	    {error, badtab};
	{_, undefined} ->
	    {error, badtab};
	{{ok, Name}, Info} ->
	    ok = disk_log:log(Name, Info),
	    tab2file(Tab, first(Tab), Name)
    end.
tab2file(Tab, K, Name) ->
    case get_objs(Tab, K, 10, []) of
	{'$end_of_table', Objs} ->
	    disk_log:log_terms(Name, Objs),
	    disk_log:close(Name);
	{Next, Objs} ->
	    disk_log:log_terms(Name, Objs),
	    tab2file(Tab, Next, Name)
    end.

get_objs(Tab, K, 0, Ack) ->
    {K, lists:reverse(Ack)};
get_objs(Tab, '$end_of_table', _, Ack) ->
    {'$end_of_table', lists:reverse(Ack)};
get_objs(Tab, K, I, Ack) ->
    Os = lookup(Tab, K),
    get_objs(Tab, next(Tab, K), I-1, Os ++ Ack).

%% Restore a table from a file, given that the file was written with
%% the tab2file/2 function from above

file2tab(File) ->
    Name  = make_ref(),
    case disk_log:open([{name, Name}, {file, File}, {mode, read_only}]) of
	{ok, Name} ->
	    init_file2tab(Name);
	{repaired, Name, _,_} ->
	    init_file2tab(Name);
	Other ->
	    old_file2tab(File)  %% compatibilty
    end.

init_file2tab(Name) ->
    case disk_log:chunk(Name, start) of
	{error, Reason} ->
	    file2tab_error(Name, Reason);
	eof ->
	    file2tab_error(Name, eof);
	{Cont, [Info | Tail]} ->
	    case catch mk_tab(tuple_to_list(Info)) of
		{'EXIT', _} ->
		    file2tab_error(Name, "Can't create table");
		{Tab, Pid} ->
		    fill_tab(Cont, Name, Tab, Tail),
		    disk_log:close(Name),
		    {ok, {Tab, Pid}}
	    end
    end.

fill_tab(C, Name, Tab, [H|T]) ->
    erlang:db_put(Tab, H),
    fill_tab(C, Name, Tab, T);
fill_tab(C, Name, Tab, []) ->
    case disk_log:chunk(Name, C) of
	{error, Reason} ->
	    erlang:db_erase(Tab),
	    file2tab_error(Name, Reason);
	eof ->
	    ok;
	{C2, Objs} ->
	    fill_tab(C2, Name, Tab, Objs)
    end.

file2tab_error(Name, Reason) ->
    disk_log:close(Name),
    {error, Reason}.

old_file2tab(File) ->
    case file:read_file(File) of
	{ok, Bin} ->
	    case catch binary_to_term(Bin) of
		{'EXIT',_} -> 
		    {error, badfile};
		{I,S} ->
		    {Tab, Pid} = mk_tab(tuple_to_list(I)),
		    insert_all(Tab, S),
		    {ok,{Tab, Pid}}
	    end;
	_ ->
	    {error, nofile}
    end.

mk_tab(I) ->
    {value, {name, Name}} = lists:keysearch(name, 1, I),
    {value, {type, Type}} = lists:keysearch(type, 1, I),
    {value, {protection, P}} = lists:keysearch(protection, 1, I),
    {value, {named_table, Val}} = lists:keysearch(named_table, 1, I),
    {value, {keypos, Kp}} = lists:keysearch(keypos, 1, I),
    new(Name, [Type, P, {keypos, Kp} | named_table(Val)]).

named_table(true) -> [named_table];
named_table(false) -> [].

insert_all(Tab, [Val|T]) ->
    erlang:db_put(Tab,Val),
    insert_all(Tab,T);
insert_all(Tab,[]) -> Tab.

chk({badrpc,R}) -> exit(R);
chk(X) -> X.


%% Print info about all tabs on the tty
i() ->
    hform('id', 'name', 'type', 'size', 'mem', 'owner'),
    io:format(" -------------------------------------"
	      "---------------------------------------\n"),
    lists:foreach({ets, prinfo}, [], tabs()), ok.

tabs() ->
    lists:keysort(1, ets:all()).

prinfo(Tab) ->
    {Id, Pid} = Tab,
    case catch prinfo2(Tab) of
	{'EXIT', _} ->
	    io:format("~-10s ... unreadable \n", [to_string(Id)]);
	ok -> 
	    ok
    end.
prinfo2(Tab) ->
    {Id, Pid} = Tab,
    Name = ets:info(Tab, name),
    Type = ets:info(Tab, type),
    Size = ets:info(Tab, size),
    Mem = ets:info(Tab, memory),
    Owner = ets:info(Tab, owner),
    hform(Id, Name, Type, Size, Mem, is_reg(Owner)).

is_reg(Owner) ->
    case process_info(Owner, registered_name) of
	{registered_name, Name} -> Name;
	_ -> Owner
    end.

%%% Arndt: this code used to truncate over-sized fields. Now it
%%% pushes the remaining entries to the right instead, rather than
%%% losing information.
hform(A0, B0, C0, D0, E0, F0) ->
    [A,B,C,D,E,F] = lists:map({ets, to_string}, [], [A0,B0,C0,D0,E0,F0]),
    A1 = pad_right(A, 15),
    B1 = pad_right(B, 17),
    C1 = pad_right(C, 5),
    D1 = pad_right(D, 6),
    E1 = pad_right(E, 8),
    %% no need to pad the last entry on the line
    io:format(" ~s ~s ~s ~s ~s ~s\n", [A1,B1,C1,D1,E1,F]).

pad_right(String, Len) ->
    if
	length(String) >= Len ->
	    String;
	true ->
	    [Space] = " ",
	    String ++ lists:duplicate(Len - length(String), Space)
    end.

to_string(X) ->
    lists:flatten(io_lib:format("~p", [X])).

%% view a specific table 
i(Tab) ->
    i(Tab, 40).
i(Tab, Height) ->
    i(Tab, Height, 80).
i(Tab, Height, Width) when integer(Tab) ->
    i({Tab, info(Tab, owner)}, Height, Width);
i(Tab, Height, Width) ->
    First = ets:first(Tab),
    display_items(Height, Width, Tab, First, 1, 1).

display_items(Height, Width, Tab, '$end_of_table', Turn, Opos) -> 
    P = 'EOT  (q)uit (p)Digits (k)ill /Regexp -->',
    choice(Height, Width, P, eot, Tab, '$end_of_table', Turn, Opos);
display_items(Height, Width, Tab, Key, Turn, Opos) when Turn < 0 ->
    i(Tab, Height, Width);
display_items(Height, Width, Tab, Key, Turn, Opos) when Turn < Height ->
    do_display(Height, Width, Tab, Key, Turn, Opos);
display_items(Height, Width, Tab, Key, Turn, Opos) when Turn >=  Height ->
    P = '(c)ontinue (q)uit (p)Digits (k)ill /Regexp -->',
    choice(Height, Width, P, normal, Tab, Key, Turn, Opos).

choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) ->
    case get_line(P, "c\n") of
	"c\n" when Mode == normal ->
	    do_display(Height, Width, Tab, Key, 1, Opos);
	"c\n" when tuple(Mode), element(1, Mode) == re ->
	    {re, Re} = Mode,
	    re_search(Height, Width, Tab, Key, Re, 1, Opos);
	"q\n" ->
	    quit;
	"k\n" ->
	    ets:delete(Tab);
	[$p|Digs]  ->
	    catch case catch list_to_integer(nonl(Digs)) of
		      {'EXIT', _} ->
			  io:format("Bad digits \n", []);
		      Number when Mode == normal ->
			  print_number(Tab, ets:first(Tab), Number);
		      Number when Mode == eot ->
			  print_number(Tab, ets:first(Tab), Number);
		      Number -> %% regexp
			  {re, Re} = Mode,
			  print_re_num(Tab, ets:first(Tab), Number, Re)
		  end,
	    choice(Height, Width, P, Mode, Tab, Key, Turn, Opos);
	[$/|Regexp]   -> %% from regexp
	    re_search(Height, Width, Tab, ets:first(Tab), nonl(Regexp), 1, 1);
	_  ->
	    choice(Height, Width, P, Mode, Tab, Key, Turn, Opos)
    end.

get_line(P, Default) ->
    case io:get_line(P) of
	"\n" ->
	    Default;
	L ->
	    L
    end.

nonl(S) -> string:strip(S, right, $\n).

print_number(Tab, Key, Num) ->
    Os = ets:lookup(Tab, Key),
    Len = length(Os),
    if 
	(Num - Len) < 1 ->
	    O = lists:nth(Num, Os),
	    io:format("~p~n", [O]); %% use ppterm here instead
	true ->
	    print_number(Tab, ets:next(Tab, Key), Num - Len)
    end.

do_display(Height, Width, Tab, Key, Turn, Opos) ->
    Objs = ets:lookup(Tab, Key),
    do_display_items(Height, Width, Objs, Opos),
    Len = length(Objs),
    display_items(Height, Width, Tab, ets:next(Tab, Key), Turn+Len, Opos+Len).

do_display_items(Height, Width, [Obj|Tail], Opos) ->
    do_display_item(Height, Width, Obj, Opos),
    do_display_items(Height, Width, Tail, Opos+1);
do_display_items(Height, Width, [], Opos) ->
    Opos.

do_display_item(Height, Width, I, Opos)  ->
    L = lists:flatten(io_lib:format("~p", [I])),
    L2 = if
	     length(L) > Width - 8 ->
		 lists:append(string:substr(L, 1, Width-13), "  ...");
	     true ->
		 L
	 end,
    io:format("<~-4w> ~s~n", [Opos,L2]).

re_search(Height, Width, Tab, '$end_of_table', Re, Turn, Opos) ->
    P = 'EOT  (q)uit (p)Digits (k)ill /Regexp -->',
    choice(Height, Width, P, {re, Re}, Tab, '$end_of_table', Turn, Opos);

re_search(Height, Width, Tab, Key, Re, Turn, Opos) when Turn < Height ->
    re_display(Height, Width, Tab, Key, ets:lookup(Tab, Key), Re, Turn, Opos);

re_search(Height, Width, Tab, Key, Re, Turn, Opos)  ->
    P = '(c)ontinue (q)uit (p)Digits (k)ill /Regexp -->',
    choice(Height, Width, P, {re, Re}, Tab, Key, Turn, Opos).

re_display(Height, Width, Tab, Key, [], Re, Turn, Opos) ->
    re_search(Height, Width, Tab, ets:next(Tab, Key), Re, Turn, Opos);
re_display(Height, Width, Tab, Key, [H|T], Re, Turn, Opos) ->
    Str = lists:flatten(io_lib:format("~p", [H])),
    case string:re_match(Str, Re) of
	{match,_,_} ->
	    do_display_item(Height, Width, H, Opos),
	    re_display(Height, Width, Tab, Key, T, Re, Turn+1, Opos+1);
	_ ->
	    re_display(Height, Width, Tab, Key, T, Re, Turn, Opos)
    end.

print_re_num(_,'$end_of_table',_,_) -> ok;
print_re_num(Tab, Key, Num, Re) ->
    Os = re_match(ets:lookup(Tab, Key), Re),
    Len = length(Os),
    if 
	(Num - Len) < 1 ->
	    O = lists:nth(Num, Os),
	    io:format("~p~n", [O]); %% use ppterm here instead
	true ->
	    print_re_num(Tab, ets:next(Tab, Key), Num - Len, Re)
    end.

re_match([], _) -> [];
re_match([H|T], Re) ->
    case string:re_match(lists:flatten(io_lib:format("~p", [H])), Re) of
	{match,_,_} -> 
	    [H|re_match(T,Re)];
	_ ->
	    re_match(T, Re)
    end.






