ets.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 744 行 · 第 1/2 页

%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved via the world wide web at http://www.erlang.org/.
%% 
%% 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 Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-module(ets).

%% Interface to the Term store BIF's
%% ets == Erlang Term Store

-export([delete/1,
	 file2tab/1,
	 filter/3,
	 foldl/3, foldr/3,
	 info/1,
	 info/2,
	 match_delete/2,
	 tab2file/2,
	 from_dets/2,
	 to_dets/2,
	 init_table/2,
	 test_ms/2,
	 tab2list/1,
         table/1,
         table/2,
	 fun2ms/1,
	 match_spec_run/2,
	 repair_continuation/2]).

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

-deprecated([{fixtable,2}]).

%% The following functions used to be found in this module, but
%% are now BIFs (i.e. implemented in C).
%%
%% all/0
%% new/2
%% delete/2
%% first/1
%% fixtable/2
%% lookup/2
%% lookup_element/3
%% insert/2
%% is_compiled_ms/1
%% last/1
%% next/2
%% prev/2
%% rename/2
%% slot/2
%% match/1
%% match/2
%% match/3
%% match_object/1
%% match_object/2
%% match_object/3
%% match_spec_compile/1
%% match_spec_run_r/3
%% select/1
%% select/2
%% select/3
%% select_reverse/1
%% select_reverse/2
%% select_reverse/3
%% select_delete/2
%% update_counter/3
%%


match_spec_run(List,CompiledMS) ->
    lists:reverse(ets:match_spec_run_r(List,CompiledMS,[])).

% $end_of_table is an allowed continuation in ets...
repair_continuation('$end_of_table',_) ->
    '$end_of_table';
% ordered_set
repair_continuation(Untouched = {Table,Lastkey,L1,N2,Bin,L2,N3,N4}, MS) when
(is_atom(Table) or is_integer(Table)),
is_list(L1),
is_integer(N2),
is_binary(Bin),
size(Bin) =:= 0,
is_list(L2),
is_integer(N3),
is_integer(N4) ->
    case ets:is_compiled_ms(Bin) of
	true ->
	    Untouched;
	false ->
	    {Table,Lastkey,L1,N2,ets:match_spec_compile(MS),L2,N3,N4}
    end;

% set/bag/duplicate_bag
repair_continuation(Untouched = {Table,N1,N2,Bin,L,N3}, MS) when
(is_atom(Table) or is_integer(Table)),
is_integer(N1),
is_integer(N2),
is_binary(Bin),
size(Bin) =:= 0,
is_list(L),
is_integer(N3) ->
    case ets:is_compiled_ms(Bin) of
	true ->
	    Untouched;
	false ->
	    {Table,N1,N2,ets:match_spec_compile(MS),L,N3}
    end.

fun2ms(ShellFun) when is_function(ShellFun) ->
    % Check that this is really a shell fun...
    case erl_eval:fun_data(ShellFun) of
        {fun_data,ImportList,Clauses} ->
            case ms_transform:transform_from_shell(
                   ?MODULE,Clauses,ImportList) of
                {error,[{_,[{_,_,Code}|_]}|_],_} ->
                    io:format("Error: ~s~n",
                              [ms_transform:format_error(Code)]),
                    {error,transform_error};
                Else ->
                    Else
            end;
        false ->
            exit({badarg,{?MODULE,fun2ms,
                          [function,called,with,real,'fun',
                           should,be,transformed,with,
                           parse_transform,'or',called,with,
                           a,'fun',generated,in,the,
                           shell]}})
    end.


foldl(F, Accu, T) ->
    ets:safe_fixtable(T, true),
    First = ets:first(T),
    try
        do_foldl(F, Accu, First, T)
    after
        ets:safe_fixtable(T, false)
    end.

do_foldl(F, Accu0, Key, T) ->
    case Key of
	'$end_of_table' ->
	    Accu0;
	_ ->
	    do_foldl(F,
		     lists:foldl(F, Accu0, ets:lookup(T, Key)),
		     ets:next(T, Key), T)
    end.

foldr(F, Accu, T) ->
    ets:safe_fixtable(T, true),
    Last = ets:last(T),
    try
        do_foldr(F, Accu, Last, T)
    after 
        ets:safe_fixtable(T, false)
    end.

do_foldr(F, Accu0, Key, T) ->
    case Key of
	'$end_of_table' ->
	    Accu0;
	_ ->
	    do_foldr(F,
		     lists:foldr(F, Accu0, ets:lookup(T, Key)),
		     ets:prev(T, Key), T)
    end.

from_dets(EtsTable, DetsTable) ->
    case (catch dets:to_ets(DetsTable, EtsTable)) of
	{error, Reason} ->
	    erlang:fault(Reason,[EtsTable,DetsTable]);
	{'EXIT', {Reason1, _Stack1}} ->
	    erlang:fault(Reason1,[EtsTable,DetsTable]);
	{'EXIT', EReason} ->
	    erlang:fault(EReason,[EtsTable,DetsTable]);
	EtsTable ->
	    true;
	Unexpected -> %% Dets bug?
	    erlang:fault(Unexpected,[EtsTable,DetsTable])
    end.

to_dets(EtsTable, DetsTable) ->
    case (catch dets:from_ets(DetsTable, EtsTable)) of
	{error, Reason} ->
	    erlang:fault(Reason,[EtsTable,DetsTable]);
	{'EXIT', {Reason1, _Stack1}} ->
	    erlang:fault(Reason1,[EtsTable,DetsTable]);
	{'EXIT', EReason} ->
	    erlang:fault(EReason,[EtsTable,DetsTable]);
	ok ->
	    DetsTable;
	Unexpected -> %% Dets bug?
	    erlang:fault(Unexpected,[EtsTable,DetsTable])
    end.

test_ms(Term,MS) ->
    case erlang:match_spec_test(Term,MS,table) of
	{ok, Result, _Flags, _Messages} ->
	    {ok, Result}; 
	{error, Errors} ->
	    {error, Errors}
    end.

init_table(Table, Fun) ->
    ets:delete_all_objects(Table),
    init_table_continue(Table, Fun(read)).

init_table_continue(_Table, end_of_input) ->
    true;
init_table_continue(Table, {List,Fun}) when is_list(List), is_function(Fun) ->
    case (catch init_table_sub(Table, List)) of
	{'EXIT', Reason} ->
	    (catch Fun(close)),
	    exit(Reason);
	true ->
	    init_table_continue(Table,Fun(read))
    end;
init_table_continue(_Table, Error) ->
    exit(Error).

init_table_sub(_Table,[]) ->
    true;
init_table_sub(Table, [H|T]) ->
    ets:insert(Table,H),
    init_table_sub(Table,T).

match_delete(Table, Pattern) ->
    ets:select_delete(Table,[{Pattern,[],[true]}]),
    true.

delete(T) when is_atom(T) ; is_integer(T) ->
    ets:db_delete(T).

info(T) when is_atom(T) ; is_integer(T) ->
    local_info(T, node()).

local_info(T, Node) ->
    case catch ets: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 is_atom(T) ; is_integer(T) ->
    local_info(T, What, node()).

local_info(T, What, Node) ->
    case What of 
	node ->
	    %% Use a bif call to determine if the table exists
	    case (catch ets:db_info(T, type)) of
		undefined ->
		    undefined;
		{'EXIT',_} ->
		    undefined;
		_ ->
		    Node
	    end;
	named_table ->
	    %% Use a bif call to determine if the table exists
	    case (catch ets:db_info(T, type)) of
		undefined ->
		    undefined;
		{'EXIT',_} ->
		    undefined;
		_ ->
		    if
			is_atom(T) -> 
			    true;
			true -> 
			    false
		    end
	    end;
	_ ->
	    case (catch ets:db_info(T, What)) of
	        undefined -> 
		    undefined;
		{'EXIT',_} -> 
		    undefined;
		Result -> 
		    Result
	    end
    end.

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

tab2list(T) ->
    ets:match_object(T, '_').

filter(Tn, F, A) when is_atom(Tn) ; is_integer(Tn) ->
    do_filter(Tn,ets:first(Tn),F,A, []).

do_filter(_Tab, '$end_of_table', _,_, Ack) -> 
    Ack;
do_filter(Tab, Key, F, A, Ack) ->
    case apply(F, [ets:lookup(Tab, Key) | A]) of
	false ->
	    do_filter(Tab, ets:next(Tab, Key), F,A,Ack);
	true ->
            Ack2 = ets:lookup(Tab, Key) ++ Ack,
	    do_filter(Tab, ets:next(Tab, Key), F,A,Ack2);
	{true, Value} ->
	    do_filter(Tab, ets:next(Tab, Key), F,A,[Value | Ack])
    end.

    
%% Dump a table to a file using the disk_log facility
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}, Info0} ->
	    %% For backwards compatibility, the table parameters should be a tuple.
	    Info = list_to_tuple(Info0),
	    ok = disk_log:log(Name, Info),
	    tab2file(Tab, ets: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 = ets:lookup(Tab, K),
    get_objs(Tab, ets: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);