%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
%%
%% 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 online 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.
%%
%% %CopyrightEnd%
%%
-module(ets_tough_SUITE).
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,ex1/1]).
-export([init/1,terminate/2,handle_call/3,handle_info/2]).
-export([init_per_testcase/2, end_per_testcase/2]).
-compile([export_all]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{suite_callbacks,[ts_install_scb]}].
all() ->
[ex1].
groups() ->
[].
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
Config.
-define(DEBUG(X),debug_disabled).
%%-define(DEBUG(X),X).
-define(GLOBAL_PARAMS,ets_tough_SUITE_global_params).
init_per_testcase(_Func, Config) ->
Dog=test_server:timetrap(test_server:seconds(300)),
[{watchdog, Dog}|Config].
end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ets:delete(?GLOBAL_PARAMS).
ex1(Config) when is_list(Config) ->
?line ets:new(?GLOBAL_PARAMS,[named_table,public]),
?line ets:insert(?GLOBAL_PARAMS,{a,set}),
?line ets:insert(?GLOBAL_PARAMS,{b,set}),
?line ex1_sub(Config),
?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
?line ets:insert(?GLOBAL_PARAMS,{b,set}),
?line ex1_sub(Config),
?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
?line ets:insert(?GLOBAL_PARAMS,{b,ordered_set}),
?line ex1_sub(Config).
ex1_sub(Config) ->
{A,B} = prep(Config),
N =
case ?config(ets_tough_SUITE_iters,Config) of
undefined ->
5000;
Other ->
Other
end,
{NewA,NewB} = run({A,B},N),
_Gurkor = lists:keysearch(gurka,1,ets:all()),
(catch stop(NewA)),
(catch stop(NewB)),
ok.
prep(Config) ->
random:seed(),
put(dump_ticket,none),
DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"),
file:make_dir(DumpDir),
put(dump_dir,DumpDir),
process_flag(trap_exit,true),
{ok, A} = start(a),
{ok, B} = start(b),
{A,B}.
run({A,B},N) ->
run(A,B,0,N).
run(A,B,N,N) ->
{A,B};
run(A,B,N,M) ->
eat_msgs(),
Op = random_operation(),
?DEBUG(io:format("~w: ",[N])),
case catch operate(Op,A,B) of
{'EXIT',Reason} ->
io:format("\nFAILURE on ~w: ~w, reason: ~w\n",[N,Op,Reason]),
exit(failed);
{new_a,NewA} ->
run(NewA,B,N+1,M);
_ ->
run(A,B,N+1,M)
end.
eat_msgs() ->
receive
_Anything ->
eat_msgs()
after 0 ->
ok
end.
operate(get,A,B) ->
case random_key() of
1 ->
Class = random_class(),
AnsA = lists:sort(dget_class(A,Class,all)),
AnsB = lists:sort(dget_class(B,Class,all)),
?DEBUG(io:format("get_class ~w (~w)\n",[Class,AnsA])),
AnsA = AnsB;
_Other ->
Class = random_class(),
Key = random_key(),
AnsA = dget(A,Class,Key),
AnsB = dget(B,Class,Key),
?DEBUG(io:format("get ~w,~w (~w)\n",[Class,Key,AnsA])),
AnsA = AnsB
end;
operate(put,A,B) ->
Class = random_class(),
Key = random_key(),
Value = random_value(),
AnsA = dput(A,Class,Key,Value),
AnsB = dput(B,Class,Key,Value),
?DEBUG(io:format("put ~w,~w=~w (~w)\n",[Class,Key,Value,AnsA])),
AnsA = AnsB;
operate(erase,A,B) ->
case random_key() of
1 ->
Class = random_class(),
AnsA = derase_class(A,Class),
AnsB = derase_class(B,Class),
?DEBUG(io:format("erase_class ~w\n",[Class])),
AnsA = AnsB;
_Other ->
Class = random_class(),
Key = random_key(),
AnsA = derase(A,Class,Key),
AnsB = derase(B,Class,Key),
?DEBUG(io:format("erase ~w,~w (~w)\n",[Class,Key,AnsA])),
AnsA = AnsB
end;
operate(dirty_get,A,_B) ->
Class = random_class(),
Key = random_key(),
%% only try dirty get on the b-side (which is never dumping)
AnsA = dget(A,Class,Key),
AnsB = dirty_dget(b,Class,Key),
?DEBUG(io:format("dirty_get ~w,~w (~w)\n",[Class,Key,AnsA])),
AnsA = AnsB;
operate(dump,A,_B) ->
case get(dump_ticket) of
{dump_more,Ticket} ->
Units = random_key(),
NewTicket = ddump_next(A,Units,Ticket),
put(dump_ticket,NewTicket),
_Result = case NewTicket of
done -> done;
_ -> dump_more
end,
?DEBUG(io:format("dump ~w (~w)\n",[Units,_Result]));
_ ->
DumpDir = get(dump_dir),
case random_key() of
1 ->
?DEBUG(io:format("start_dump\n",[])),
NewTicket = ddump_first(A,DumpDir),
put(dump_ticket,NewTicket);
2 ->
?DEBUG(io:format("dump_and_restore\n",[])),
{dump_more,NewTicket} = ddump_first(A,DumpDir),
done = ddump_next(A,1000000,NewTicket),
stop(A),
{ok, NewA} = start(a,DumpDir),
{new_a,NewA};
_ ->
?DEBUG(io:format("idle\n",[])),
ok
end
end.
random_operation() ->
Ops = {get,put,erase,dirty_get,dump},
random_element(Ops).
random_class() ->
Classes = {foo,bar,tomat,gurka},
random_element(Classes).
random_key() ->
random:uniform(8).
random_value() ->
case random:uniform(5) of
1 -> ok;
2 -> {data,random_key()};
3 -> {foo,bar,random_class()};
4 -> random:uniform(1000);
5 -> {recursive,random_value()}
end.
random_element(T) ->
I = random:uniform(tuple_size(T)),
element(I,T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
show_table(N) ->
FileName = ["etsdump.",integer_to_list(N)],
case file:open(FileName,read) of
{ok,Fd} ->
show_entries(Fd);
_ ->
error
end.
show_entries(Fd) ->
case phys_read_len(Fd) of
{ok,Len} ->
case phys_read_entry(Fd,Len) of
{ok,ok} ->
ok;
{ok,{Key,Val}} ->
io:format("~w\n",[{Key,Val}]),
show_entries(Fd);
_ ->
error
end;
_ ->
error
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-define(NAMED_TABLES,true).
-define(DB_NAME_KEY, {'$db_name'}).
-define(LIST_OF_CLASSES_KEY,{'$list_of_classes'}).
-define(DUMPING_FLAG_KEY,{'$dumping_flag'}).
-define(DUMP_DIRECTORY_KEY,{'$dump_directory'}).
-define(ERASE_MARK(Key),{{{'$erased'},Key}}).
-define(ets_new,ets:new).
-define(ets_lookup,ets:lookup).
-define(ets_insert,ets:insert). % erlang:db_put
-define(ets_delete,ets:delete). % erlang:db_erase
-define(ets_first,ets:first). % erlang:db_first
-define(ets_next,ets:next). % erlang:db_next_key
-define(ets_info,ets:info). % erlang:db_info
%%% INTERFACE FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% start(DbName) -> Pid | {error,Reason}
%%%
%%% Starts the ets table database with name DbName
start(DbName) ->
case gen_server:start_link(ets_tough_SUITE,{DbName,no_dump_dir},[]) of
{ok,Pid} when is_pid(Pid) ->
{ok, Pid};
Other ->
Other
end.
%%% start(DbName,DumpDir) -> Pid | {error,Reason}
%%%
%%% Starts the ets table database with name DbName, and reads a dump
%%% from DumpDir when it starts.
start(DbName,DumpDir) ->
case gen_server:start_link(ets_tough_SUITE,
{DbName,{dump_dir,DumpDir}},[]) of
{ok,Pid} when is_pid(Pid) ->
{ok, Pid};
Other ->
Other
end.
%%% stop(ServerPid) -> {'EXIT',shutdown}
%%%
%%% Shuts down the ets table database
stop(ServerPid) ->
gen_server:call(ServerPid,stop).
%%% dget(ServerPid,Class,Key) -> {value,Value} | undefined
%%%
%%% Returns a value identified by Class,Key from the database, or
%%% 'undefined' if there is no such value.
dget(ServerPid,Class,Key) ->
gen_server:call(ServerPid,{handle_lookup,Class,Key}).
%%% dirty_dget(DbName,Class,Key) -> {value,Value} | undefined
%%%
%%% This is looks up the value directly in the ets table
%%% to avoid message passing. Several databases may be started,
%%% so the admin table must be registered.
dirty_dget(DbName,Class,Key) ->
Admin = admin_table_name(DbName),
case catch(?ets_lookup(Admin,Class)) of
[{_Class,[Tab|_Tabs]}] ->
case ?ets_lookup(Tab,Key) of
[{_Key,Value}] ->
{value,Value};
_ ->
undefined
end;
_ ->
undefined
end.
%%% dput(ServerPid,Class,Key,Value) -> undefined | {value,OldValue}
%%%
%%% Inserts the given Value to be identified by Class,Key. Any prevoius
%%% value is returned, or otherwise 'undefined'.
dput(ServerPid,Class,Key,Value) ->
gen_server:call(ServerPid,{handle_insert,Class,Key,Value}).
%%% derase(ServerPid,Class,Key) -> undefined | {value,OldValue}
%%%
%%% Erases any value identified by Class,Key
derase(ServerPid,Class,Key) ->
gen_server:call(ServerPid,{handle_delete,Class,Key}).
%%% dget_class(ServerPid,Class,Condition) -> KeyList
%%%
%%% Returns a list of keys where the instance match Condition.
%%% Condition = 'all' returns all keys in the class.
%%% The condition is supplied as Condition = {Mod, Fun, ExtraArgs},
%%% where the instance will be prepended to ExtraArgs before each
%%% call is made.
dget_class(ServerPid,Class,Condition) ->
gen_server:call(ServerPid,
{handle_get_class,Class,Condition},infinity).
%%% derase_class(ServerPid,Class) -> ok
%%%
%%% Erases a whole class, identified by Class
derase_class(ServerPid,Class) ->
gen_server:call(ServerPid,{handle_delete_class,Class}, infinity).
%%% dmodify(ServerPid,Application) -> ok
%%%
%%% Applies a function on every instance in the database.
%%% The user provided function must always return one of the
%%% terms {ok,NewItem}, true, or false.
%%% Aug 96, this is only used to reset all timestamp values
%%% in the database.
%%% The function is supplied as Application = {Mod, Fun, ExtraArgs},
%%% where the instance will be prepended to ExtraArgs before each
%%% call is made.
dmodify(ServerPid,Application) ->
gen_server:call(ServerPid,{handle_dmodify,Application}, infinity).
%%% ddump_first(ServerPid,DumpDir) -> {dump_more,Ticket} | already_dumping
%%%
%%% Starts dumping the database. This call redirects all database updates
%%% to temporary tables, so that exactly the same database image will be
%%% written to disk as is in memory when this function is called.
%%% The returned Ticket is to be used with ddump_next/2
ddump_first(ServerPid,DumpDir) ->
gen_server:call(ServerPid,{handle_dump_first,DumpDir}, infinity).
%%% ddump_next(ServerPid,Count,Ticket) -> {dump_more,Ticket} | done
%%%
%%% Dumps the database. This function performs Count units of dump work.
%%% Higher value of Count makes the entire dump operation more efficient,
%%% but blocks the database for longer periods of time.
%%% If there is still more work to be done, a new Ticket is returned,
%%% or 'done' otherwise.
ddump_next(ServerPid,Count,Ticket) ->
gen_server:call(ServerPid,{handle_dump_next,Ticket,Count},150000).
%%% PRIVATE HANDLER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Admin
%%% -----
%%%
%%% The database has a main administrative table Admin. It always contains
%%% these four items:
%%%
%%% {{'$db_name'},Name}
%%% {{'$list_of_classes'},ListOfClasses}
%%% {{'$dumping_flag'},BoolDumping}
%%% {{'$dump_directory'},Dir}
%%%
%%% The ListOfClasses is simply a list of all Classes that has ever been
%%% inserted in the database. It's used to know which tables to dump.
%%% The dump flag is 'true' while dump is in progress, to make it
%%% impossible to start a new dump before an old dump is completed.
%%%
%%% For each class there is an entry of the form
%%%
%%% {Class,ListOfTables}
%%%
%%% Where the ListOfTables is the list of class tables (see below)
%%%
%%% Class Tables
%%% ------------
%%%
%%% The class tables are common ets tables that have the actual user
%%% data stored in them.
%%%
%%% Normally there is only one class table, Mtab (main table).
%%% When dumping is initiated, each class is syncronously given a
%%% temporary table, Ttab, where all updates are stored. Reads are
%%% directed to the Ttab first, and only if not found there, Mtab is
%%% consulted.
%%%
%%% Writes always go to the first table in the table sequence. This
%%% ensures that the dump algorithm can enumerate the entries in the
%%% other tables, without risk of being disrupted.
%%%
%%% When the dumping to disk is completed, it's time to write back
%%% whatever updates that came into the Ttab to Mtab. To do this, a
%%% third table is needed, Utab, to handle all updates while Ttab is
%%% being copied to Mtab. When all of Ttab is copied, Ttab is thrown
%%% away, and the whole process is repeated with Utab as Ttab until
%%% eventually nobody wrote to Utab while Ttab was copied (clean run).
%%%
%%% There is no _guarantee_ that this will ever happen, but unless there
%%% is a constant (and quite high frequency) stream of updates to a
%%% particular class, this should work.
%%%
%%% (It is possible to make this failsafe, by copying the elements in
%%% Mtab to Ttab. This is probably a lot more expensive, though)
%%%
%%% Erasure during dump
%%% -------------------
%%%
%%% Erasing need special attention when a single class has several
%%% tables. It really boils down to a number of cases:
%%%
%%% - element does not exist in Ttab.
%%% A special erase record is written, {{{'$erased'},Key}} which
%%% is hopefully different from all other keys used by the user.
%%% - element exists in Ttab
%%% The element is deleted, and erase record is written
%%% - element does not exist in Ttab, but there is an erase record
%%% fine, do nothing
%%% - element exist in Ttab, and there is an erase record
%%% This happens when a record is deleted from Ttab, then written
%%% back again. Erase records are not looked for when inserting
%%% new data (and that's not necessary)
%%%
%%% Then when Ttab should be copied to Mtab:
%%%
%%% - found an element
%%% Usual case, just copy
%%% - found erase record
%%% Check if there is an element with the same key as the erase
%%% record. If so it has been written later than the erasure, so
%%% the erasure is obsolete. Otherwise erase the record from Mtab.
%%%
%%% Delete Class
%%% ------------
%%%
%%% A slight problem is deleting an entire class while dumping is in
%%% progress. For consitency, all user visible traces of the class must
%%% be deleted, while dumping must not be affected. On top of that, the
%%% deleted class may well be recreated while dumping is still going on,
%%% and entries added.
%%%
%%% This is solved by having the dump algorithm keep track of the table
%%% identifiers of the tables to dump, rather than asking the admin table
%%% (since the class might be deleted there). The dump algorithm will
%%% itself take care of deleting the tables used in the dumping, while the
%%% normal database interface deletes the "first table", the table that is
%%% currently accepting all write operations.
init({DbName,DumpDir}) ->
case DumpDir of
no_dump_dir ->
Admin = make_admin_table(DbName),
?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[]}),
init2(DbName,Admin);
{dump_dir,Dir} ->
case load_dump(DbName,Dir) of
{ok,Admin} ->
?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,Dir}),
init2(DbName,Admin);
_ ->
cant_load_dump
end
end.
init2(DbName,Admin) ->
?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
{ok, Admin}.
terminate(_Reason,_Admin) ->
ok.
handle_call({handle_lookup,Class,Key},_From,Admin) ->
%% Lookup tables to search in
Reply =
case ?ets_lookup(Admin,Class) of
[] ->
undefined; %% no such class => no such record
[{_,TabList}] ->
{_,Ans} = table_lookup(TabList, Key),
Ans
end,
{reply,Reply,Admin};
handle_call({handle_insert,Class,Key,Value},_From,Admin) ->
%% Lookup in which table to write
Reply =
case ?ets_lookup(Admin,Class) of
[] ->
%% undefined class, let's create it
Mtab = make_db_table(db_name(Admin),Class),
?ets_insert(Admin,{Class,[Mtab]}),
[{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[Class|Classes]}),
?ets_insert(Mtab, {Key, Value}),
undefined;
[{_,[Tab|Tabs]}] ->
{_,Old} = table_lookup([Tab|Tabs], Key),
?ets_insert(Tab, {Key, Value}),
Old
end,
{reply,Reply,Admin};
handle_call({handle_delete,Class,Key},_From,Admin) ->
%% Lookup in which table to write
Reply =
case ?ets_lookup(Admin, Class) of
[] ->
undefined; %% no such class, but delete is happy anyway
[{_,[Tab]}] ->
%% When there is only one table, simply deleting is enough
{_,Old} = table_lookup(Tab,Key),
?ets_delete(Tab,Key),
Old;
[{_,[Tab|Tabs]}] ->
%% When there are more tables, we have to write a delete
%% record into the first one, so that nobody goes looking
%% for this entry in some other table
{_,Old} = table_lookup([Tab|Tabs],Key),
?ets_insert(Tab, {?ERASE_MARK(Key), erased}),
?ets_delete(Tab,Key),
Old
end,
{reply,Reply,Admin};
handle_call({handle_get_class,Class,Cond},_From,Admin) ->
Reply =
case ?ets_lookup(Admin,Class) of % Lookup tables to search in
[] ->
[]; % no such class
[{_,TabList}] ->
table_lookup_batch(TabList, Class, Cond) % get class data
end,
{reply,Reply,Admin};
handle_call({handle_delete_class,Class},_From,Admin) ->
Reply =
case ?ets_lookup(Admin, Class) of
[] ->
ok; % no such class, but delete_class is happy anyway
[{_,[Tab|_Tabs]}] ->
%% Always delete the first table (the one we're writing into)
%% In case we're dumping, the rest of the tables will be
%% taken care of by the dump algorithm.
?ets_delete(Tab),
[{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
NewClasses = lists:delete(Class, Classes),
?ets_insert(Admin, {?LIST_OF_CLASSES_KEY, NewClasses}),
?ets_delete(Admin, Class),
ok
end,
{reply,Reply,Admin};
handle_call({handle_dmodify,Application},_From,Admin) ->
[{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
modify(Application, Classes, Admin),
{reply,ok,Admin};
handle_call({handle_dump_first,DumpDir},_From,Admin) ->
case ?ets_lookup(Admin,?DUMPING_FLAG_KEY) of
[{_,true}] ->
{reply,already_dumping,Admin};
_ ->
phys_remove_ok(DumpDir),
[{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
Tables = dump_prepare_classes(Classes,Admin),
?ets_insert(Admin,{?DUMPING_FLAG_KEY,true}),
%% this is the new dir for dumping:
?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,DumpDir}),
handle_dump_next({[{admin,Classes}|Tables]},0,Admin)
end;
%% All done, good work!
handle_call({handle_dump_next,Ticket,Count},_From,Admin) ->
handle_dump_next(Ticket,Count,Admin);
handle_call(stop,_From,Admin) ->
?ets_delete(Admin), % Make sure table is gone before reply is sent.
{stop, normal, ok, []}.
handle_info({'EXIT',_Pid,_Reason},Admin) ->
{stop,normal,Admin}.
handle_delete(Class, Key, Admin) ->
handle_call({handle_delete,Class,Key},from,Admin).
handle_insert(Class, Key, Value, Admin) ->
handle_call({handle_insert,Class,Key,Value},from,Admin).
handle_lookup(Class, Key, Admin) ->
handle_call({handle_lookup,Class,Key},from,Admin).
handle_dump_next({[]},_Count,Admin) ->
[{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
phys_ok_dump(DumpDir),
?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
{reply,done,Admin};
%% No more operations, return to user asking for more
handle_dump_next(Ticket,0,Admin) ->
{reply,{dump_more,Ticket},Admin};
%% Dump the admin table. Costs one dump-work unit.
handle_dump_next({[{admin,Classes}|Tables]},Count,Admin) ->
[{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
DumpData = phys_init_dump(admin,DumpDir,0),
phys_dump({?LIST_OF_CLASSES_KEY,Classes},DumpData),
phys_finish_dump(DumpData),
handle_dump_next({Tables},Count-1,Admin);
%% Pick out a class and start dumping it
handle_dump_next({[{Class,Mtab}|Tables]},Count,Admin) ->
?DEBUG(io:format("DUMP CLASS ~w\n",[Class])),
[{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
DumpData = phys_init_dump(Class,DumpDir,length(Tables)+1),
First = ?ets_first(Mtab),
handle_dump_next({Class,Tables,Mtab,First,DumpData},Count,Admin);
%% All keys in this class have been written to disk, now we have to
%% copy all items from temporary Ttab to main Mtab
handle_dump_next({Class,Tables,Stab,'$end_of_table',DumpData},Count,Admin) ->
phys_finish_dump(DumpData),
?DEBUG(io:format("Cleaning up temporary table in ~p\n",[Class])),
case ?ets_lookup(Admin,Class) of
[{Key,[Utab,Mtab]}] ->
Ttab = make_db_table(db_name(Admin),Class),
?ets_insert(Admin,{Key,[Ttab,Utab,Mtab]}),
First = ?ets_first(Utab),
handle_dump_next({3,Class,Tables,Utab,First,Mtab},Count,Admin);
_Other ->
%% Class deleted (and maybe recreated) while dumping, no need to
%% bring this one up to date. Just discard late additions.
?ets_delete(Stab),
handle_dump_next({Tables},Count,Admin)
end;
%% Dumping one key to disk. Costs one dump-work unit.
handle_dump_next({Class,Tables,Tab,Key,DumpData},Count,Admin) ->
[KeyVal] = ?ets_lookup(Tab,Key),
phys_dump(KeyVal,DumpData),
NextKey = ?ets_next(Tab,Key),
handle_dump_next({Class,Tables,Tab,NextKey,DumpData},Count-1,Admin);
%% Done copying elements from Ttab to Mtab
%% check if Utab is empty and go on with next class, or
%% make Utab the current Ttab, and run again
%% ... will this ever end? ;-)
handle_dump_next({3,Class,Tables,Stab,'$end_of_table',Dtab},Count,Admin) ->
case ?ets_lookup(Admin,Class) of
[{Key,[Ttab,Utab,Mtab]}] ->
case ?ets_info(Ttab,size) of
0 ->
?ets_insert(Admin,{Key,[Mtab]}),
?ets_delete(Ttab),
?ets_delete(Utab),
handle_dump_next({Tables},Count,Admin);
_Work ->
?DEBUG(io:format("Switching direction in ~p\n",[Class])),
%% Which is faster, deleting all the entries
%% in a table, or deleting it and create a new?
?ets_delete(Utab),
Ntab = make_db_table(db_name(Admin),Class),
?ets_insert(Admin,{Key,[Ntab,Ttab,Mtab]}),
First = ?ets_first(Ttab),
handle_dump_next({3,Class,Tables,Ttab,First,Mtab},
Count,Admin)
end;
_Other ->
%% Class deleted (and maybe recreated) while dumping, no need to
%% bring this one up to date. Just discard late additions.
?ets_delete(Stab),
?ets_delete(Dtab),
handle_dump_next({Tables},Count,Admin)
end;
%% Copy one key from Ttab to Mtab
%% costs one dump-work unit
handle_dump_next({3,Class,Tables,Stab,Key,Dtab},Count,Admin) ->
copy_dump_entry(Stab,Key,Dtab),
NextKey = ?ets_next(Stab,Key),
handle_dump_next({3,Class,Tables,Stab,NextKey,Dtab},Count-1,Admin).
%%% INTERNAL HELPER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% admin_table_name(DbName) -> Name
%%%
%%% Returns the name of the admin table of the table DbName
admin_table_name(DbName) ->
list_to_atom(lists:append(atom_to_list(DbName),"#admin")).
%%% make_admin_table(DbName) -> EtsAdminTable
%%%
%%% Creates and registers an ETS Admin table
make_admin_table(DbName) ->
?ets_new(admin_table_name(DbName),[named_table,protected,db_type(DbName)]).
%%% make_db_table(DbName,Name) -> EtsTable
%%%
%%% Creates an ETS database table
make_db_table(DbName, Name) ->
?ets_new(Name,[protected,db_type(DbName)]).
db_name(Admin) ->
ets:lookup_element(Admin,?DB_NAME_KEY,2).
db_type(DbName) ->
case ets:lookup(?GLOBAL_PARAMS, DbName) of
[] ->
set;
[{DbName,X}] ->
X
end.
%%% table_lookup(Table,Key) ->
%%% table_lookup(TableList,Key) ->
%%% {def,{value,Value}} | {undef,undefined} | (erased,undefined}
%%%
%%% Looks up key in the table and returns it value, or undefined
%%% if there is no such key.
%%% If a list of tables is given, they are searched one after another
%%% for a matching key, until one is found. The search is discontinued
%%% if a record telling that the key was deleted is found.
table_lookup([], _Key) ->
{undef,undefined};
table_lookup([Table|Tables], Key) ->
case table_lookup(Table,Key) of
{_,undefined} ->
case ?ets_lookup(Table,?ERASE_MARK(Key)) of
[] ->
table_lookup(Tables,Key);
_Definition ->
%% The element has been deleted, don't look further!
%% Pretend we never saw anything..
{erased,undefined}
end;
Answer ->
Answer
end;
table_lookup(Table, Key) ->
case ?ets_lookup(Table,Key) of
[] ->
{undef,undefined};
[{_Key,Value}] ->
{def,{value,Value}}
end.
%%% table_lookup_batch(Tables, Class, Cond) -> KeyList
%%%
%%% Extract the keys from a table or a table group.
%%% If a condition is supplied, it is on the form {Mod, Fun, ExtraArgs}
%%% and returns {true,Key} or false when called using
%%% apply(Mod, Fun, [Instance|ExtraArgs]).
%%% Instance is, for historic reasons, {{Class, Key}, Value} when the function
%%% is called. Cond = 'all' can be used to get all keys from a class.
table_lookup_batch([],_Class,_Cond) ->
[];
table_lookup_batch([Table|Tables],Class,Cond) ->
table_lookup_batch([],Tables,Table,ets:first(Table),Class,Cond,[]).
table_lookup_batch(_Passed,[],_,'$end_of_table',_Class,_Cond,Ack) ->
Ack;
table_lookup_batch(Passed,[NewTable|Tables],Table,'$end_of_table',
Class,Cond,Ack) ->
table_lookup_batch(lists:append(Passed,[Table]),Tables,
NewTable,ets:first(NewTable),Class,Cond,Ack);
table_lookup_batch(Passed,Tables,Table,?ERASE_MARK(Key),Class,Cond,Ack) ->
table_lookup_batch(Passed,Tables,Table,?ets_next(Table,?ERASE_MARK(Key)),
Class,Cond,Ack);
table_lookup_batch(Passed,Tables,Table,Key,Class,Cond,Ack) ->
NewAck =
case table_lookup(Passed,Key) of
{undef,undefined} ->
[{_Key,Value}] = ?ets_lookup(Table,Key),
case Cond of % are there any conditions?
all ->
[Key|Ack];
{M, F, A} ->
%% apply the condition test.
%% Applications need keys to consist of
%% {class, primkey}, so we make it that way
case apply(M, F, [{{Class, Key}, Value}|A]) of
{true, Key} -> [Key|Ack];
false -> Ack
end
end;
_Other ->
%% Already processed (or erased) key
%% {def,{value,Value}} ->
%% {erased,undefined} ->
Ack
end,
table_lookup_batch(Passed,Tables,Table,?ets_next(Table,Key),
Class,Cond,NewAck).
%%% modify(Application, ClassList, Admin) -> ok.
%%%
%%% This function modifies each element of the classes
modify(_Application, [], _Admin) ->
ok;
modify(Application, [Class|Classes], Admin) ->
?DEBUG(io:format("modifying class ~p\n", [Class])),
[{_,Tables}] = ?ets_lookup(Admin, Class),
modify_class(Application, Class, table_lookup_batch(Tables, Class, all),
Admin),
modify(Application, Classes, Admin).
modify_class(_Application, _Class, [], _Admin) ->
ok;
modify_class({Mod, Fun, ExtraArgs}, Class, [Key|Keys], Admin) ->
{ok, {{value, Value}, _Admin}} = handle_lookup(Class, Key, Admin),
%% The applications think that a key consists of {class, primkey},
%% so let them.
case apply(Mod,Fun,[{{Class, Key}, Value}|ExtraArgs]) of
{ok,{{NewClass, NewKey}, NewValue}} -> % The item is modified.
%% remove old instance, insert new
%% JALI could be optimized (we don't care about previous values),
%% but ets_delete/insert is *not* enough
handle_delete(Class, Key, Admin),
handle_insert(NewClass, NewKey, NewValue, Admin);
true -> % The item should be left as it is.
ok;
false -> % The item should be removed!
%% JALI could be optimized (we don't care about previous values),
%% but ets_delete is *not* enough
handle_delete(Class, Key, Admin)
end,
modify_class({Mod, Fun, ExtraArgs}, Class, Keys, Admin).
%%% dump_prepare_classes(Classes,Admin) -> ok
%%%
%%% Create a Ttab for each class, and insert
%%% the new table order in Admin
dump_prepare_classes(Classes,Admin) ->
?DEBUG(io:format("DUMP CLASSES ~w\n",[Classes])),
dump_prepare_classes(Classes,Admin,[]).
dump_prepare_classes([],_Admin,Ack) ->
Ack;
dump_prepare_classes([Class|Classes],Admin,Ack) ->
[{_Class,[Mtab]}] = ?ets_lookup(Admin,Class),
%% Only one table => we can prepare for dumping
%% In case there are several tables defined, dumping is
%% already (still) in progress for this class (database inconsistent)
Ttab = make_db_table(db_name(Admin),Class),
?ets_insert(Admin,{Class,[Ttab,Mtab]}),
dump_prepare_classes(Classes,Admin,lists:append(Ack,[{Class,Mtab}])).
%%% copy_dump_entry(SourceTable,Key,DestinationTable) -> NobodyCares
%%%
%%% Copies Key from SourceTable to DestinationTable.
%%% If Key is an erase record, then the corresponding entry is deleted
%%% from DestinationTable, if it should be (see Erasure during dump, above)
copy_dump_entry(Stab,Key,Dtab) ->
?DEBUG(io:format("Copying key ~p\n",[Key])),
case ?ets_lookup(Stab,Key) of
[{?ERASE_MARK(RealKey),_}] ->
%% Only erase if the entry RealKey hasn't been written again
case ?ets_lookup(Stab,RealKey) of
[] ->
%% No, it hasn't: we should delete
?DEBUG(io:format("Erasing: ~p\n",[RealKey])),
?ets_delete(Dtab,RealKey);
_Definition ->
%% It has, don't erase. In this case the new value
%% has already or will soon be written to Dtab
ok
end;
[KeyVal] ->
?DEBUG(io:format("Forwarding: ~p\n",[KeyVal])),
?ets_insert(Dtab,KeyVal)
end.
%%% DUMP LOADING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
load_dump(DbName,DumpDir) ->
case phys_load_dump_ok(DumpDir) of
ok ->
Admin = make_admin_table(DbName),
?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
case phys_load_table(DumpDir,0,Admin) of
ok ->
load_dump2(DumpDir,Admin);
Other ->
load_dump_failed(Admin,[]),
{error,{load_dump1,Other}}
end;
Other ->
{error,{load_dump2,Other}}
end.
load_dump2(DumpDir,Admin) ->
case ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY) of
[{_Key,Classes}] ->
case load_dump_tables(DumpDir,Admin,Classes) of
ok ->
{ok, Admin};
Other ->
io:format("Dumping failed: ~p\n",[Other]),
load_dump_failed(Admin,Classes)
end;
Other ->
io:format("Dumping failed2: ~p\n",[Other]),
load_dump_failed(Admin,[])
end.
load_dump_failed(Admin,[]) ->
?ets_delete(Admin),
{error,load_dump_failed};
load_dump_failed(Admin,[Class|Classes]) ->
case ?ets_lookup(Admin,Class) of
[{_Key,[Tab]}] ->
?ets_delete(Tab);
_ ->
ok
end,
load_dump_failed(Admin,Classes).
load_dump_tables(_DumpDir,_Admin,[]) ->
ok;
load_dump_tables(DumpDir,Admin,[Class|Classes]) ->
Mtab = make_db_table(db_name(Admin),Class),
?ets_insert(Admin,{Class,[Mtab]}),
Num = length(Classes)+1,
case phys_load_table(DumpDir,Num,Mtab) of
ok ->
load_dump_tables(DumpDir,Admin,Classes);
Other ->
{error,{load_dump_failed,Other}}
end.
%%% FILE ACCESS LAYER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% phys_init_dump(Class,DumpDir) -> DumpData
phys_init_dump(Class,DumpDir,Num) ->
?DEBUG(io:format("Opened ~p for writing\n",[Class])),
FileName = [DumpDir,"/etsdump.",integer_to_list(Num)],
{tag1,{ok,Fd}} = {tag1,file:open(FileName,write)},
{Class,Fd}.
%%% phys_finish_dump(DumpData) -> NobodyCares
phys_finish_dump({_Class,Fd}) ->
?DEBUG(io:format("Closed ~p\n",[_Class])),
phys_dump_term(Fd,ok),
file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
ok.
%%% phys_dump(KeyVal,DumpData) -> NobodyCares
phys_dump({Key,Val},{_Class,Fd}) ->
?DEBUG(io:format("To disk (~p.dump): {~p,~p}\n",[_Class,Key,Val])),
phys_dump_term(Fd,{Key,Val}),
ok.
phys_dump_term(Fd,Term) ->
Bin = binary_to_list(term_to_binary(Term)),
{tag2,ok} = {tag2,io:put_chars(Fd,encode32(length(Bin)))},
{tag3,ok} = {tag3,io:put_chars(Fd,Bin)}.
%%% phys_ok_dump(DumpDir) -> NobodyCares
phys_ok_dump(DumpDir) ->
?DEBUG(io:format("Ok:ing dump dir ~s\n",[DumpDir])),
FileName = [DumpDir,"/ok"],
{tag4,{ok,Fd}} = {tag4,file:open(FileName,write)},
{tag5,ok} = {tag5,io:format(Fd,"ok.\n",[])},
file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
ok.
phys_remove_ok(DumpDir) ->
?DEBUG(io:format("Removing any Ok in dump dir ~s\n",[DumpDir])),
FileName = [DumpDir,"/ok"],
%% don't care if delete returns ok, file probably doesn't exist
file:delete(FileName),
ok.
phys_load_dump_ok(DumpDir) ->
FileName = [DumpDir,"/ok"],
case file:consult(FileName) of
{ok,[ok]} ->
ok;
Other ->
{error,{consult_error,Other}}
end.
phys_load_table(DumpDir,N,Tab) ->
?DEBUG(io:format("LOAD TABLE ~w\n",[N])),
FileName = [DumpDir,"/etsdump.",integer_to_list(N)],
case file:open(FileName,read) of
{ok,Fd} ->
phys_load_entries(Fd,Tab);
Other ->
{error,{open_error,Other}}
end.
phys_load_entries(Fd,Tab) ->
case phys_read_len(Fd) of
{ok,Len} ->
case phys_read_entry(Fd,Len) of
{ok,ok} ->
ok;
{ok,{Key,Val}} ->
?ets_insert(Tab,{Key,Val}),
phys_load_entries(Fd,Tab);
Other ->
{error,{read_len,Other}}
end;
Other ->
{error,{read_len2,Other}}
end.
phys_read_len(Fd) ->
case io:get_chars(Fd,'',4) of
[A,B,C,D] ->
{ok,decode32(A,B,C,D)};
Other ->
{error,{decode,Other}}
end.
phys_read_entry(Fd,Len) ->
case io:get_chars(Fd,'',Len) of
L when is_list(L), length(L) == Len ->
{ok,binary_to_term(list_to_binary(L))};
Other ->
{error,{read_term,Other}}
end.
encode32(N) ->
[(N bsr 24) band 255,
(N bsr 16) band 255,
(N bsr 8) band 255,
N band 255].
decode32(A,B,C,D) ->
(A bsl 24) bor (B bsl 16) bor (C bsl 8) bor D.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
