aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/test/ets_tough_SUITE.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/stdlib/test/ets_tough_SUITE.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/stdlib/test/ets_tough_SUITE.erl')
-rw-r--r--lib/stdlib/test/ets_tough_SUITE.erl1093
1 files changed, 1093 insertions, 0 deletions
diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl
new file mode 100644
index 0000000000..e3d44d00b9
--- /dev/null
+++ b/lib/stdlib/test/ets_tough_SUITE.erl
@@ -0,0 +1,1093 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. 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/1,ex1/1]).
+-export([init/1,terminate/2,handle_call/3,handle_info/2]).
+-export([init_per_testcase/2, fin_per_testcase/2]).
+-compile([export_all]).
+-include("test_server.hrl").
+
+all(suite) -> [ex1].
+
+
+-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].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ets:delete(?GLOBAL_PARAMS).
+
+
+ex1(Config) when 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 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 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 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.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%