1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 1996-2011. All Rights Reserved.
    5: %%
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %%
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %%
   17: %% %CopyrightEnd%
   18: %%
   19: -module(ets_tough_SUITE).
   20: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   21: 	 init_per_group/2,end_per_group/2,ex1/1]).
   22: -export([init/1,terminate/2,handle_call/3,handle_info/2]).
   23: -export([init_per_testcase/2, end_per_testcase/2]).
   24: -compile([export_all]).
   25: -include_lib("test_server/include/test_server.hrl").
   26: 
   27: suite() -> [{ct_hooks,[ts_install_cth]}].
   28: 
   29: all() -> 
   30:     [ex1].
   31: 
   32: groups() -> 
   33:     [].
   34: 
   35: init_per_suite(Config) ->
   36:     Config.
   37: 
   38: end_per_suite(_Config) ->
   39:     ok.
   40: 
   41: init_per_group(_GroupName, Config) ->
   42:     Config.
   43: 
   44: end_per_group(_GroupName, Config) ->
   45:     Config.
   46: 
   47: 
   48: 
   49: -define(DEBUG(X),debug_disabled).
   50: %%-define(DEBUG(X),X).
   51: -define(GLOBAL_PARAMS,ets_tough_SUITE_global_params).
   52: 
   53: init_per_testcase(_Func, Config) ->
   54:     Dog=test_server:timetrap(test_server:seconds(300)),
   55:     [{watchdog, Dog}|Config].
   56: 
   57: end_per_testcase(_Func, Config) ->
   58:     Dog=?config(watchdog, Config),
   59:     test_server:timetrap_cancel(Dog),
   60:     ets:delete(?GLOBAL_PARAMS).
   61: 
   62: 
   63: ex1(Config) when is_list(Config) ->
   64:     ?line ets:new(?GLOBAL_PARAMS,[named_table,public]),
   65:     ?line ets:insert(?GLOBAL_PARAMS,{a,set}),
   66:     ?line ets:insert(?GLOBAL_PARAMS,{b,set}),
   67:     ?line ex1_sub(Config),
   68:     ?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
   69:     ?line ets:insert(?GLOBAL_PARAMS,{b,set}),
   70:     ?line ex1_sub(Config),
   71:     ?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
   72:     ?line ets:insert(?GLOBAL_PARAMS,{b,ordered_set}),
   73:     ?line ex1_sub(Config).    
   74:     
   75:     
   76: 
   77: 
   78: ex1_sub(Config) ->
   79:     {A,B} = prep(Config),
   80:     N = 
   81: 	case ?config(ets_tough_SUITE_iters,Config) of
   82: 	    undefined ->
   83: 		5000;
   84: 	    Other -> 
   85: 		Other
   86: 	end,
   87:     {NewA,NewB} = run({A,B},N),
   88:     _Gurkor = lists:keysearch(gurka,1,ets:all()),
   89:     (catch stop(NewA)),
   90:     (catch stop(NewB)),
   91:     ok.
   92: 
   93: prep(Config) ->
   94:     random:seed(),
   95:     put(dump_ticket,none),
   96:     DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"),
   97:     file:make_dir(DumpDir),
   98:     put(dump_dir,DumpDir),
   99:     process_flag(trap_exit,true),
  100:     {ok, A} = start(a),
  101:     {ok, B} = start(b),
  102:     {A,B}.
  103: 
  104: run({A,B},N) ->
  105:     run(A,B,0,N).
  106: 
  107: run(A,B,N,N) ->
  108:     {A,B};
  109: run(A,B,N,M) ->
  110:     eat_msgs(),
  111:     Op = random_operation(),
  112:     ?DEBUG(io:format("~w: ",[N])),
  113:     case catch operate(Op,A,B) of
  114: 	{'EXIT',Reason} ->
  115: 	    io:format("\nFAILURE on ~w: ~w, reason: ~w\n",[N,Op,Reason]),
  116: 	    exit(failed);
  117: 	{new_a,NewA} ->
  118: 	    run(NewA,B,N+1,M);
  119: 	_ ->
  120: 	    run(A,B,N+1,M)
  121:     end.
  122: 
  123: eat_msgs() ->
  124:     receive
  125: 	_Anything ->
  126: 	    eat_msgs()
  127:     after 0 ->
  128: 	    ok
  129:     end.
  130: 
  131: operate(get,A,B) ->
  132:     case random_key() of
  133: 	1 ->
  134: 	    Class = random_class(),
  135: 	    AnsA = lists:sort(dget_class(A,Class,all)),
  136: 	    AnsB = lists:sort(dget_class(B,Class,all)),
  137: 	    ?DEBUG(io:format("get_class ~w (~w)\n",[Class,AnsA])),
  138: 	    AnsA = AnsB;
  139: 	_Other ->
  140: 	    Class = random_class(),
  141: 	    Key = random_key(),
  142: 	    AnsA = dget(A,Class,Key),
  143: 	    AnsB = dget(B,Class,Key),
  144: 	    ?DEBUG(io:format("get ~w,~w (~w)\n",[Class,Key,AnsA])),
  145: 	    AnsA = AnsB
  146:     end;
  147: 
  148: operate(put,A,B) ->
  149:     Class = random_class(),
  150:     Key = random_key(),
  151:     Value = random_value(),
  152:     AnsA = dput(A,Class,Key,Value),
  153:     AnsB = dput(B,Class,Key,Value),
  154:     ?DEBUG(io:format("put ~w,~w=~w (~w)\n",[Class,Key,Value,AnsA])),
  155:     AnsA = AnsB;
  156: 
  157: operate(erase,A,B) ->
  158:     case random_key() of
  159: 	1 ->
  160: 	    Class = random_class(),
  161: 	    AnsA = derase_class(A,Class),
  162: 	    AnsB = derase_class(B,Class),
  163: 	    ?DEBUG(io:format("erase_class ~w\n",[Class])),
  164: 	    AnsA = AnsB;
  165: 	_Other ->
  166: 	    Class = random_class(),
  167: 	    Key = random_key(),
  168: 	    AnsA = derase(A,Class,Key),
  169: 	    AnsB = derase(B,Class,Key),
  170: 	    ?DEBUG(io:format("erase ~w,~w (~w)\n",[Class,Key,AnsA])),
  171: 	    AnsA = AnsB
  172:     end;
  173: 
  174: operate(dirty_get,A,_B) ->
  175:     Class = random_class(),
  176:     Key = random_key(),
  177:     %% only try dirty get on the b-side (which is never dumping)
  178:     AnsA = dget(A,Class,Key),
  179:     AnsB = dirty_dget(b,Class,Key),
  180:     ?DEBUG(io:format("dirty_get ~w,~w (~w)\n",[Class,Key,AnsA])),
  181:     AnsA = AnsB;
  182: 
  183: operate(dump,A,_B) ->
  184:     case get(dump_ticket) of
  185: 	{dump_more,Ticket} ->
  186: 	    Units = random_key(),
  187: 	    NewTicket = ddump_next(A,Units,Ticket),
  188: 	    put(dump_ticket,NewTicket),
  189: 	    _Result = case NewTicket of
  190: 			 done -> done;
  191: 			 _ ->    dump_more
  192: 		     end,
  193: 	    ?DEBUG(io:format("dump ~w (~w)\n",[Units,_Result]));
  194: 	_ ->
  195: 	    DumpDir = get(dump_dir),
  196: 	    case random_key() of
  197: 		1 ->
  198: 		    ?DEBUG(io:format("start_dump\n",[])),
  199: 		    NewTicket = ddump_first(A,DumpDir),
  200: 		    put(dump_ticket,NewTicket);
  201: 		2 ->
  202: 		    ?DEBUG(io:format("dump_and_restore\n",[])),
  203: 		    {dump_more,NewTicket} = ddump_first(A,DumpDir),
  204: 		    done = ddump_next(A,1000000,NewTicket),
  205: 		    stop(A),
  206: 		    {ok, NewA} = start(a,DumpDir),
  207: 		    {new_a,NewA};
  208: 		_ ->
  209: 		    ?DEBUG(io:format("idle\n",[])),
  210: 		    ok
  211: 	    end
  212:     end.
  213:     
  214: random_operation() ->
  215:     Ops = {get,put,erase,dirty_get,dump},
  216:     random_element(Ops).
  217: 
  218: random_class() ->
  219:     Classes = {foo,bar,tomat,gurka},
  220:     random_element(Classes).
  221: 
  222: random_key() ->
  223:     random:uniform(8).
  224: 
  225: random_value() ->
  226:     case random:uniform(5) of
  227: 	1 -> ok;
  228: 	2 -> {data,random_key()};
  229: 	3 -> {foo,bar,random_class()};
  230: 	4 -> random:uniform(1000);
  231: 	5 -> {recursive,random_value()}
  232:     end.
  233: 
  234: random_element(T) ->
  235:     I = random:uniform(tuple_size(T)),
  236:     element(I,T).
  237: 
  238: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  239: 
  240: show_table(N) ->
  241:     FileName = ["etsdump.",integer_to_list(N)],
  242:     case file:open(FileName,read) of
  243: 	{ok,Fd} ->
  244: 	    show_entries(Fd);
  245: 	_ ->
  246: 	    error
  247:     end.
  248: 	    
  249: show_entries(Fd) ->
  250:     case phys_read_len(Fd) of
  251: 	{ok,Len} ->
  252: 	    case phys_read_entry(Fd,Len) of
  253: 		{ok,ok} ->
  254: 		    ok;
  255: 		{ok,{Key,Val}} ->
  256: 		    io:format("~w\n",[{Key,Val}]),
  257: 		    show_entries(Fd);
  258: 		_ ->
  259: 		    error
  260: 	    end;
  261: 	_ ->
  262: 	    error
  263:     end.
  264: 
  265: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  266: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  267: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  268: %%% DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  269: 
  270: -define(NAMED_TABLES,true).
  271: -define(DB_NAME_KEY, {'$db_name'}).
  272: -define(LIST_OF_CLASSES_KEY,{'$list_of_classes'}).
  273: -define(DUMPING_FLAG_KEY,{'$dumping_flag'}).
  274: -define(DUMP_DIRECTORY_KEY,{'$dump_directory'}).
  275: -define(ERASE_MARK(Key),{{{'$erased'},Key}}).
  276: -define(ets_new,ets:new).
  277: -define(ets_lookup,ets:lookup).
  278: -define(ets_insert,ets:insert).    % erlang:db_put
  279: -define(ets_delete,ets:delete).    % erlang:db_erase
  280: -define(ets_first,ets:first).      % erlang:db_first
  281: -define(ets_next,ets:next).        % erlang:db_next_key
  282: -define(ets_info,ets:info).        % erlang:db_info
  283: 
  284: %%% INTERFACE FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  285: 
  286: %%% start(DbName) -> Pid | {error,Reason}
  287: %%%
  288: %%% Starts the ets table database with name DbName
  289: 
  290: start(DbName) ->
  291:     case gen_server:start_link(ets_tough_SUITE,{DbName,no_dump_dir},[]) of
  292: 	{ok,Pid} when is_pid(Pid) ->
  293: 	    {ok, Pid};
  294: 	Other ->
  295: 	    Other
  296:     end.
  297: 
  298: %%% start(DbName,DumpDir) -> Pid | {error,Reason}
  299: %%%
  300: %%% Starts the ets table database with name DbName, and reads a dump
  301: %%% from DumpDir when it starts.
  302: 
  303: start(DbName,DumpDir) ->
  304:     case gen_server:start_link(ets_tough_SUITE,
  305: 			       {DbName,{dump_dir,DumpDir}},[]) of
  306: 	{ok,Pid} when is_pid(Pid) ->
  307: 	    {ok, Pid};
  308: 	Other ->
  309: 	    Other
  310:     end.
  311: 
  312: %%% stop(ServerPid) -> {'EXIT',shutdown}
  313: %%%
  314: %%% Shuts down the ets table database
  315: 
  316: stop(ServerPid) ->
  317:     gen_server:call(ServerPid,stop).
  318: 
  319: %%% dget(ServerPid,Class,Key) -> {value,Value} | undefined
  320: %%%
  321: %%% Returns a value identified by Class,Key from the database, or
  322: %%% 'undefined' if there is no such value.
  323: 
  324: dget(ServerPid,Class,Key) ->
  325:     gen_server:call(ServerPid,{handle_lookup,Class,Key}).
  326: 
  327: %%% dirty_dget(DbName,Class,Key) -> {value,Value} | undefined
  328: %%%
  329: %%% This is looks up the value directly in the ets table
  330: %%% to avoid message passing. Several databases may be started,
  331: %%% so the admin table must be registered.
  332: 
  333: dirty_dget(DbName,Class,Key) ->
  334:     Admin = admin_table_name(DbName),
  335:     case catch(?ets_lookup(Admin,Class)) of
  336: 	[{_Class,[Tab|_Tabs]}] ->
  337: 	    case ?ets_lookup(Tab,Key) of
  338: 		[{_Key,Value}] ->
  339: 		    {value,Value};
  340: 		_ ->
  341: 		    undefined
  342: 	    end;
  343: 	_ ->
  344: 	    undefined
  345:     end.
  346: 
  347: %%% dput(ServerPid,Class,Key,Value) -> undefined | {value,OldValue}
  348: %%%
  349: %%% Inserts the given Value to be identified by Class,Key. Any prevoius
  350: %%% value is returned, or otherwise 'undefined'.
  351: 
  352: dput(ServerPid,Class,Key,Value) ->
  353:     gen_server:call(ServerPid,{handle_insert,Class,Key,Value}).
  354: 
  355: %%% derase(ServerPid,Class,Key) -> undefined | {value,OldValue}
  356: %%%
  357: %%% Erases any value identified by Class,Key
  358: 
  359: derase(ServerPid,Class,Key) ->
  360:     gen_server:call(ServerPid,{handle_delete,Class,Key}).
  361: 
  362: %%% dget_class(ServerPid,Class,Condition) -> KeyList
  363: %%%
  364: %%% Returns a list of keys where the instance match Condition.
  365: %%% Condition = 'all' returns all keys in the class.
  366: %%% The condition is supplied as Condition = {Mod, Fun, ExtraArgs},
  367: %%% where the instance will be prepended to ExtraArgs before each
  368: %%% call is made.
  369: 
  370: dget_class(ServerPid,Class,Condition) ->
  371:     gen_server:call(ServerPid,
  372: 		       {handle_get_class,Class,Condition},infinity).
  373: 
  374: %%% derase_class(ServerPid,Class) -> ok
  375: %%%
  376: %%% Erases a whole class, identified by Class
  377: 
  378: derase_class(ServerPid,Class) ->
  379:     gen_server:call(ServerPid,{handle_delete_class,Class}, infinity).
  380: 
  381: %%% dmodify(ServerPid,Application) -> ok
  382: %%%
  383: %%% Applies a function on every instance in the database.
  384: %%% The user provided function must always return one of the
  385: %%% terms {ok,NewItem}, true, or false.
  386: %%% Aug 96, this is only used to reset all timestamp values
  387: %%% in the database.
  388: %%% The function is supplied as Application = {Mod, Fun, ExtraArgs},
  389: %%% where the instance will be prepended to ExtraArgs before each
  390: %%% call is made.
  391: 
  392: dmodify(ServerPid,Application) ->
  393:     gen_server:call(ServerPid,{handle_dmodify,Application}, infinity).
  394: 
  395: %%% ddump_first(ServerPid,DumpDir) -> {dump_more,Ticket} | already_dumping
  396: %%%
  397: %%% Starts dumping the database. This call redirects all database updates
  398: %%% to temporary tables, so that exactly the same database image will be
  399: %%% written to disk as is in memory when this function is called.
  400: %%% The returned Ticket is to be used with ddump_next/2
  401: 
  402: ddump_first(ServerPid,DumpDir) ->
  403:     gen_server:call(ServerPid,{handle_dump_first,DumpDir}, infinity).
  404: 
  405: %%% ddump_next(ServerPid,Count,Ticket) -> {dump_more,Ticket} | done
  406: %%%
  407: %%% Dumps the database. This function performs Count units of dump work.
  408: %%% Higher value of Count makes the entire dump operation more efficient,
  409: %%% but blocks the database for longer periods of time.
  410: %%% If there is still more work to be done, a new Ticket is returned,
  411: %%% or 'done' otherwise.
  412: 
  413: ddump_next(ServerPid,Count,Ticket) ->
  414:     gen_server:call(ServerPid,{handle_dump_next,Ticket,Count},150000).
  415: 
  416: %%% PRIVATE HANDLER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  417: 
  418: %%% Admin
  419: %%% -----
  420: %%%
  421: %%% The database has a main administrative table Admin. It always contains
  422: %%% these four items:
  423: %%%
  424: %%%    {{'$db_name'},Name}
  425: %%%    {{'$list_of_classes'},ListOfClasses}
  426: %%%    {{'$dumping_flag'},BoolDumping}
  427: %%%    {{'$dump_directory'},Dir}
  428: %%%
  429: %%% The ListOfClasses is simply a list of all Classes that has ever been
  430: %%% inserted in the database. It's used to know which tables to dump.
  431: %%% The dump flag is 'true' while dump is in progress, to make it
  432: %%% impossible to start a new dump before an old dump is completed.
  433: %%%
  434: %%% For each class there is an entry of the form
  435: %%%
  436: %%%    {Class,ListOfTables}
  437: %%%
  438: %%% Where the ListOfTables is the list of class tables (see below)
  439: %%%
  440: %%% Class Tables
  441: %%% ------------
  442: %%%
  443: %%% The class tables are common ets tables that have the actual user
  444: %%% data stored in them.
  445: %%%
  446: %%% Normally there is only one class table, Mtab (main table).
  447: %%% When dumping is initiated, each class is syncronously given a 
  448: %%% temporary table, Ttab, where all updates are stored. Reads are 
  449: %%% directed to the Ttab first, and only if not found there, Mtab is
  450: %%% consulted.
  451: %%%
  452: %%% Writes always go to the first table in the table sequence. This
  453: %%% ensures that the dump algorithm can enumerate the entries in the
  454: %%% other tables, without risk of being disrupted.
  455: %%%
  456: %%% When the dumping to disk is completed, it's time to write back
  457: %%% whatever updates that came into the Ttab to Mtab. To do this, a
  458: %%% third table is needed, Utab, to handle all updates while Ttab is
  459: %%% being copied to Mtab. When all of Ttab is copied, Ttab is thrown
  460: %%% away, and the whole process is repeated with Utab as Ttab until
  461: %%% eventually nobody wrote to Utab while Ttab was copied (clean run).
  462: %%%
  463: %%% There is no _guarantee_ that this will ever happen, but unless there
  464: %%% is a constant (and quite high frequency) stream of updates to a
  465: %%% particular class, this should work.
  466: %%%
  467: %%% (It is possible to make this failsafe, by copying the elements in
  468: %%% Mtab to Ttab. This is probably a lot more expensive, though)
  469: %%%
  470: %%% Erasure during dump
  471: %%% -------------------
  472: %%%
  473: %%% Erasing need special attention when a single class has several 
  474: %%% tables. It really boils down to a number of cases:
  475: %%% 
  476: %%% - element does not exist in Ttab.
  477: %%%     A special erase record is written, {{{'$erased'},Key}} which
  478: %%%     is hopefully different from all other keys used by the user.
  479: %%% - element exists in Ttab
  480: %%%     The element is deleted, and erase record is written
  481: %%% - element does not exist in Ttab, but there is an erase record
  482: %%%     fine, do nothing
  483: %%% - element exist in Ttab, and there is an erase record
  484: %%%     This happens when a record is deleted from Ttab, then written
  485: %%%     back again. Erase records are not looked for when inserting
  486: %%%     new data (and that's not necessary)
  487: %%%
  488: %%% Then when Ttab should be copied to Mtab:
  489: %%%
  490: %%% - found an element
  491: %%%     Usual case, just copy
  492: %%% - found erase record
  493: %%%     Check if there is an element with the same key as the erase
  494: %%%     record. If so it has been written later than the erasure, so
  495: %%%     the erasure is obsolete. Otherwise erase the record from Mtab.
  496: %%%
  497: %%% Delete Class
  498: %%% ------------
  499: %%%
  500: %%% A slight problem is deleting an entire class while dumping is in
  501: %%% progress. For consitency, all user visible traces of the class must
  502: %%% be deleted, while dumping must not be affected. On top of that, the
  503: %%% deleted class may well be recreated while dumping is still going on,
  504: %%% and entries added.
  505: %%%
  506: %%% This is solved by having the dump algorithm keep track of the table
  507: %%% identifiers of the tables to dump, rather than asking the admin table
  508: %%% (since the class might be deleted there). The dump algorithm will
  509: %%% itself take care of deleting the tables used in the dumping, while the
  510: %%% normal database interface deletes the "first table", the table that is
  511: %%% currently accepting all write operations.
  512: 
  513: 
  514: init({DbName,DumpDir}) ->
  515:     case DumpDir of
  516: 	no_dump_dir ->
  517: 	    Admin = make_admin_table(DbName),
  518: 	    ?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[]}),
  519: 	    init2(DbName,Admin);
  520: 	{dump_dir,Dir} ->
  521: 	    case load_dump(DbName,Dir) of
  522: 		{ok,Admin} ->
  523: 		    ?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,Dir}),
  524: 		    init2(DbName,Admin);
  525: 		_ ->
  526: 		    cant_load_dump
  527: 	    end
  528:     end.
  529: 
  530: init2(DbName,Admin) ->
  531:     ?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
  532:     ?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
  533:     {ok, Admin}.
  534: 
  535: terminate(_Reason,_Admin) ->
  536:     ok.
  537: 
  538: handle_call({handle_lookup,Class,Key},_From,Admin) ->
  539:     %% Lookup tables to search in
  540:     Reply =
  541: 	case ?ets_lookup(Admin,Class) of
  542: 	    [] ->
  543: 		undefined; %% no such class => no such record
  544: 	    [{_,TabList}] ->
  545: 		{_,Ans} = table_lookup(TabList, Key),
  546: 		Ans
  547: 	end,
  548:     {reply,Reply,Admin};
  549: 
  550: handle_call({handle_insert,Class,Key,Value},_From,Admin) ->
  551:     %% Lookup in which table to write
  552:     Reply = 
  553: 	case ?ets_lookup(Admin,Class) of
  554: 	    [] ->
  555: 		%% undefined class, let's create it
  556: 		Mtab = make_db_table(db_name(Admin),Class),
  557: 		?ets_insert(Admin,{Class,[Mtab]}),
  558: 		[{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
  559: 		?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[Class|Classes]}),
  560: 		?ets_insert(Mtab, {Key, Value}),
  561: 		undefined;
  562: 	    [{_,[Tab|Tabs]}] ->
  563: 		{_,Old} = table_lookup([Tab|Tabs], Key),
  564: 		?ets_insert(Tab, {Key, Value}),
  565: 		Old
  566: 	end,
  567:     {reply,Reply,Admin};
  568: 
  569: handle_call({handle_delete,Class,Key},_From,Admin) ->
  570:     %% Lookup in which table to write
  571:     Reply =
  572: 	case ?ets_lookup(Admin, Class) of
  573: 	    [] ->
  574: 		undefined; %% no such class, but delete is happy anyway
  575: 	    [{_,[Tab]}] ->
  576: 		%% When there is only one table, simply deleting is enough
  577: 		{_,Old} = table_lookup(Tab,Key),
  578: 		?ets_delete(Tab,Key),
  579: 		Old;
  580: 	    [{_,[Tab|Tabs]}] ->
  581: 		%% When there are more tables, we have to write a delete
  582: 		%% record into the first one, so that nobody goes looking
  583: 		%% for this entry in some other table
  584: 		{_,Old} = table_lookup([Tab|Tabs],Key),
  585: 		?ets_insert(Tab, {?ERASE_MARK(Key), erased}),
  586: 		?ets_delete(Tab,Key),
  587: 		Old
  588: 	end,
  589:     {reply,Reply,Admin};
  590: 
  591: handle_call({handle_get_class,Class,Cond},_From,Admin) ->
  592:     Reply =
  593: 	case ?ets_lookup(Admin,Class) of     % Lookup tables to search in
  594: 	    [] ->
  595: 		[];          % no such class
  596: 	    [{_,TabList}] ->
  597: 		table_lookup_batch(TabList, Class, Cond)  % get class data
  598: 	end,
  599:     {reply,Reply,Admin};
  600: 
  601: handle_call({handle_delete_class,Class},_From,Admin) ->
  602:     Reply =
  603: 	case ?ets_lookup(Admin, Class) of
  604: 	    [] ->
  605: 		ok;     % no such class, but delete_class is happy anyway
  606: 	    [{_,[Tab|_Tabs]}] ->
  607: 		%% Always delete the first table (the one we're writing into)
  608: 		%% In case we're dumping, the rest of the tables will be
  609: 		%% taken care of by the dump algorithm.
  610: 		?ets_delete(Tab),
  611: 		[{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
  612: 		NewClasses = lists:delete(Class, Classes),
  613: 		?ets_insert(Admin, {?LIST_OF_CLASSES_KEY, NewClasses}),
  614: 		?ets_delete(Admin, Class),
  615: 		ok
  616: 	end,
  617:     {reply,Reply,Admin};
  618: 
  619: handle_call({handle_dmodify,Application},_From,Admin) ->
  620:     [{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
  621:     modify(Application, Classes, Admin),
  622:     {reply,ok,Admin};
  623: 
  624: handle_call({handle_dump_first,DumpDir},_From,Admin) ->
  625:     case ?ets_lookup(Admin,?DUMPING_FLAG_KEY) of
  626: 	[{_,true}] ->
  627: 	    {reply,already_dumping,Admin};
  628: 	_ ->
  629: 	    phys_remove_ok(DumpDir),
  630: 	    [{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
  631: 	    Tables = dump_prepare_classes(Classes,Admin),
  632: 	    ?ets_insert(Admin,{?DUMPING_FLAG_KEY,true}),
  633: 	    %% this is the new dir for dumping:
  634: 	    ?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,DumpDir}),
  635: 	    handle_dump_next({[{admin,Classes}|Tables]},0,Admin)
  636:     end;
  637: 
  638: %% All done, good work!
  639: handle_call({handle_dump_next,Ticket,Count},_From,Admin) ->
  640:     handle_dump_next(Ticket,Count,Admin);
  641: 
  642: handle_call(stop,_From,Admin) ->
  643:     ?ets_delete(Admin), % Make sure table is gone before reply is sent.
  644:     {stop, normal, ok, []}.
  645: 
  646: handle_info({'EXIT',_Pid,_Reason},Admin) ->
  647:     {stop,normal,Admin}.
  648: 
  649: handle_delete(Class, Key, Admin) ->
  650:     handle_call({handle_delete,Class,Key},from,Admin).
  651: 
  652: handle_insert(Class, Key, Value, Admin) ->
  653:     handle_call({handle_insert,Class,Key,Value},from,Admin).
  654: 
  655: handle_lookup(Class, Key, Admin) ->
  656:     handle_call({handle_lookup,Class,Key},from,Admin).
  657: 
  658: 
  659: handle_dump_next({[]},_Count,Admin) ->
  660:     [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
  661:     phys_ok_dump(DumpDir),
  662:     ?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
  663:     {reply,done,Admin};
  664: 
  665: %% No more operations, return to user asking for more
  666: handle_dump_next(Ticket,0,Admin) ->
  667:     {reply,{dump_more,Ticket},Admin};
  668: 
  669: %% Dump the admin table. Costs one dump-work unit.
  670: handle_dump_next({[{admin,Classes}|Tables]},Count,Admin) ->
  671:     [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
  672:     DumpData = phys_init_dump(admin,DumpDir,0),
  673:     phys_dump({?LIST_OF_CLASSES_KEY,Classes},DumpData),
  674:     phys_finish_dump(DumpData),
  675:     handle_dump_next({Tables},Count-1,Admin);
  676: 
  677: %% Pick out a class and start dumping it
  678: handle_dump_next({[{Class,Mtab}|Tables]},Count,Admin) ->
  679:     ?DEBUG(io:format("DUMP CLASS ~w\n",[Class])),
  680:     [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
  681:     DumpData = phys_init_dump(Class,DumpDir,length(Tables)+1),
  682:     First = ?ets_first(Mtab),
  683:     handle_dump_next({Class,Tables,Mtab,First,DumpData},Count,Admin);
  684: 
  685: %% All keys in this class have been written to disk, now we have to
  686: %% copy all items from temporary Ttab to main Mtab
  687: handle_dump_next({Class,Tables,Stab,'$end_of_table',DumpData},Count,Admin) ->
  688:     phys_finish_dump(DumpData),
  689:     ?DEBUG(io:format("Cleaning up temporary table in ~p\n",[Class])),
  690:     case ?ets_lookup(Admin,Class) of
  691: 	[{Key,[Utab,Mtab]}] ->
  692: 	    Ttab = make_db_table(db_name(Admin),Class),
  693: 	    ?ets_insert(Admin,{Key,[Ttab,Utab,Mtab]}),
  694: 	    First = ?ets_first(Utab),
  695: 	    handle_dump_next({3,Class,Tables,Utab,First,Mtab},Count,Admin);
  696: 	_Other ->
  697: 	    %% Class deleted (and maybe recreated) while dumping, no need to 
  698: 	    %% bring this one up to date. Just discard late additions.
  699: 	    ?ets_delete(Stab),
  700: 	    handle_dump_next({Tables},Count,Admin)
  701:     end;
  702: 
  703: %% Dumping one key to disk. Costs one dump-work unit.
  704: handle_dump_next({Class,Tables,Tab,Key,DumpData},Count,Admin) ->
  705:     [KeyVal] = ?ets_lookup(Tab,Key),
  706:     phys_dump(KeyVal,DumpData),
  707:     NextKey = ?ets_next(Tab,Key),
  708:     handle_dump_next({Class,Tables,Tab,NextKey,DumpData},Count-1,Admin);
  709: 
  710: %% Done copying elements from Ttab to Mtab
  711: %% check if Utab is empty and go on with next class, or
  712: %% make Utab the current Ttab, and run again
  713: %% ... will this ever end? ;-)
  714: handle_dump_next({3,Class,Tables,Stab,'$end_of_table',Dtab},Count,Admin) ->
  715:     case ?ets_lookup(Admin,Class) of
  716: 	[{Key,[Ttab,Utab,Mtab]}] ->
  717: 	    case ?ets_info(Ttab,size) of
  718: 		0 ->
  719: 		    ?ets_insert(Admin,{Key,[Mtab]}),
  720: 		    ?ets_delete(Ttab),
  721: 		    ?ets_delete(Utab),
  722: 		    handle_dump_next({Tables},Count,Admin);
  723: 		_Work ->
  724: 		    ?DEBUG(io:format("Switching direction in ~p\n",[Class])),
  725: 		    %% Which is faster, deleting all the entries
  726: 		    %% in a table, or deleting it and create a new?
  727: 		    ?ets_delete(Utab),
  728: 		    Ntab = make_db_table(db_name(Admin),Class),
  729: 		    ?ets_insert(Admin,{Key,[Ntab,Ttab,Mtab]}),
  730: 		    First = ?ets_first(Ttab),
  731: 		    handle_dump_next({3,Class,Tables,Ttab,First,Mtab},
  732: 				     Count,Admin)
  733: 	    end;
  734: 	_Other ->
  735: 	    %% Class deleted (and maybe recreated) while dumping, no need to 
  736: 	    %% bring this one up to date. Just discard late additions.
  737: 	    ?ets_delete(Stab),
  738: 	    ?ets_delete(Dtab),
  739: 	    handle_dump_next({Tables},Count,Admin)
  740:     end;
  741: 
  742: %% Copy one key from Ttab to Mtab
  743: %% costs one dump-work unit
  744: handle_dump_next({3,Class,Tables,Stab,Key,Dtab},Count,Admin) ->
  745:     copy_dump_entry(Stab,Key,Dtab),
  746:     NextKey = ?ets_next(Stab,Key),
  747:     handle_dump_next({3,Class,Tables,Stab,NextKey,Dtab},Count-1,Admin).
  748: 
  749: %%% INTERNAL HELPER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  750: 
  751: %%% admin_table_name(DbName) -> Name
  752: %%%
  753: %%% Returns the name of the admin table of the table DbName
  754: 
  755: admin_table_name(DbName) ->
  756:     list_to_atom(lists:append(atom_to_list(DbName),"#admin")).
  757: 
  758: %%% make_admin_table(DbName) -> EtsAdminTable
  759: %%%
  760: %%% Creates and registers an ETS Admin table
  761: 
  762: make_admin_table(DbName) ->
  763:     ?ets_new(admin_table_name(DbName),[named_table,protected,db_type(DbName)]).
  764: 
  765: %%% make_db_table(DbName,Name) -> EtsTable
  766: %%%
  767: %%% Creates an ETS database table
  768: 
  769: make_db_table(DbName, Name) ->
  770:     ?ets_new(Name,[protected,db_type(DbName)]).
  771: 
  772: db_name(Admin) ->
  773:     ets:lookup_element(Admin,?DB_NAME_KEY,2).
  774: 
  775: db_type(DbName) ->
  776:     case ets:lookup(?GLOBAL_PARAMS, DbName) of
  777: 	[] ->
  778: 	    set;
  779: 	[{DbName,X}] ->
  780: 	    X
  781:     end.
  782: 
  783: %%% table_lookup(Table,Key) -> 
  784: %%% table_lookup(TableList,Key) ->
  785: %%%    {def,{value,Value}} | {undef,undefined} | (erased,undefined}
  786: %%%
  787: %%% Looks up key in the table and returns it value, or undefined
  788: %%% if there is no such key.
  789: %%% If a list of tables is given, they are searched one after another
  790: %%% for a matching key, until one is found. The search is discontinued
  791: %%% if a record telling that the key was deleted is found.
  792: 
  793: table_lookup([], _Key) ->
  794:     {undef,undefined};
  795: table_lookup([Table|Tables], Key) ->
  796:     case table_lookup(Table,Key) of
  797: 	{_,undefined} ->
  798: 	    case ?ets_lookup(Table,?ERASE_MARK(Key)) of
  799: 		[] ->
  800: 		    table_lookup(Tables,Key);
  801: 		_Definition ->
  802: 		    %% The element has been deleted, don't look further!
  803: 		    %% Pretend we never saw anything..
  804: 		    {erased,undefined}
  805: 	    end;
  806: 	Answer ->
  807: 	    Answer
  808:     end;
  809: table_lookup(Table, Key) ->
  810:     case ?ets_lookup(Table,Key) of
  811: 	[] ->
  812: 	    {undef,undefined};
  813: 	[{_Key,Value}] ->
  814: 	    {def,{value,Value}}
  815:     end.
  816: 
  817: %%% table_lookup_batch(Tables, Class, Cond) -> KeyList
  818: %%%
  819: %%% Extract the keys from a table or a table group.
  820: %%% If a condition is supplied, it is on the form {Mod, Fun, ExtraArgs}
  821: %%% and returns {true,Key} or false when called using
  822: %%% apply(Mod, Fun, [Instance|ExtraArgs]).
  823: %%% Instance is, for historic reasons, {{Class, Key}, Value} when the function
  824: %%% is called. Cond = 'all' can be used to get all keys from a class.
  825: 
  826: table_lookup_batch([],_Class,_Cond) ->
  827:     [];
  828: table_lookup_batch([Table|Tables],Class,Cond) ->
  829:     table_lookup_batch([],Tables,Table,ets:first(Table),Class,Cond,[]).
  830:     
  831: table_lookup_batch(_Passed,[],_,'$end_of_table',_Class,_Cond,Ack) ->
  832:     Ack;
  833: table_lookup_batch(Passed,[NewTable|Tables],Table,'$end_of_table',
  834: 		   Class,Cond,Ack) ->
  835:     table_lookup_batch(lists:append(Passed,[Table]),Tables,
  836: 		       NewTable,ets:first(NewTable),Class,Cond,Ack);
  837: table_lookup_batch(Passed,Tables,Table,?ERASE_MARK(Key),Class,Cond,Ack) ->
  838:     table_lookup_batch(Passed,Tables,Table,?ets_next(Table,?ERASE_MARK(Key)),
  839: 		       Class,Cond,Ack);
  840:     
  841: table_lookup_batch(Passed,Tables,Table,Key,Class,Cond,Ack) ->
  842:     NewAck =
  843: 	case table_lookup(Passed,Key) of
  844: 	    {undef,undefined} ->
  845: 		[{_Key,Value}] = ?ets_lookup(Table,Key),
  846: 		case Cond of    % are there any conditions?
  847: 		    all ->
  848: 			[Key|Ack];
  849: 		    {M, F, A} ->
  850: 			%% apply the condition test.
  851: 			%% Applications need keys to consist of
  852: 			%% {class, primkey}, so we make it that way
  853: 			case apply(M, F, [{{Class, Key}, Value}|A]) of
  854: 			    {true, Key} -> [Key|Ack];
  855: 			    false ->       Ack
  856: 			end
  857: 		end;
  858: 	    _Other -> 
  859: 		%% Already processed (or erased) key
  860: 		%% {def,{value,Value}} ->
  861: 		%% {erased,undefined} ->
  862: 		Ack
  863: 	end,
  864:     table_lookup_batch(Passed,Tables,Table,?ets_next(Table,Key),
  865: 		       Class,Cond,NewAck).
  866: 
  867: %%% modify(Application, ClassList, Admin) -> ok.
  868: %%%
  869: %%% This function modifies each element of the classes
  870: 
  871: modify(_Application, [], _Admin) ->
  872:     ok;
  873: modify(Application, [Class|Classes], Admin) ->
  874:     ?DEBUG(io:format("modifying class ~p\n", [Class])),
  875:     [{_,Tables}] = ?ets_lookup(Admin, Class),
  876:     modify_class(Application, Class, table_lookup_batch(Tables, Class, all),
  877: 		 Admin),
  878:     modify(Application, Classes, Admin).
  879: 
  880: modify_class(_Application, _Class, [], _Admin) ->
  881:     ok;
  882: modify_class({Mod, Fun, ExtraArgs}, Class, [Key|Keys], Admin) ->
  883:     {ok, {{value, Value}, _Admin}} = handle_lookup(Class, Key, Admin),
  884:     %% The applications think that a key consists of {class, primkey},
  885:     %% so let them.
  886:     case apply(Mod,Fun,[{{Class, Key}, Value}|ExtraArgs]) of
  887: 	{ok,{{NewClass, NewKey}, NewValue}} ->   % The item is modified.
  888: 	    %% remove old instance, insert new
  889: 	    %% JALI could be optimized (we don't care about previous values),
  890: 	    %% but ets_delete/insert is *not* enough
  891: 	    handle_delete(Class, Key, Admin),
  892: 	    handle_insert(NewClass, NewKey, NewValue, Admin);
  893: 	true ->                           % The item should be left as it is.
  894: 	    ok;
  895: 	false ->                          % The item should be removed!
  896: 	    %% JALI could be optimized (we don't care about previous values),
  897: 	    %% but ets_delete is *not* enough
  898: 	    handle_delete(Class, Key, Admin)
  899:     end,
  900:     modify_class({Mod, Fun, ExtraArgs}, Class, Keys, Admin).
  901: 
  902: %%% dump_prepare_classes(Classes,Admin) -> ok
  903: %%%
  904: %%% Create a Ttab for each class, and insert 
  905: %%% the new table order in Admin
  906: 
  907: dump_prepare_classes(Classes,Admin) ->
  908:     ?DEBUG(io:format("DUMP CLASSES ~w\n",[Classes])),
  909:     dump_prepare_classes(Classes,Admin,[]).
  910: 
  911: dump_prepare_classes([],_Admin,Ack) ->
  912:     Ack;
  913: dump_prepare_classes([Class|Classes],Admin,Ack) ->
  914:     [{_Class,[Mtab]}] = ?ets_lookup(Admin,Class),
  915:     %% Only one table => we can prepare for dumping
  916:     %% In case there are several tables defined, dumping is
  917:     %% already (still) in progress for this class (database inconsistent)
  918:     Ttab = make_db_table(db_name(Admin),Class),
  919:     ?ets_insert(Admin,{Class,[Ttab,Mtab]}),
  920:     dump_prepare_classes(Classes,Admin,lists:append(Ack,[{Class,Mtab}])).
  921: 
  922: %%% copy_dump_entry(SourceTable,Key,DestinationTable) -> NobodyCares
  923: %%%
  924: %%% Copies Key from SourceTable to DestinationTable.
  925: %%% If Key is an erase record, then the corresponding entry is deleted
  926: %%% from DestinationTable, if it should be (see Erasure during dump, above)
  927: 
  928: copy_dump_entry(Stab,Key,Dtab) ->
  929:     ?DEBUG(io:format("Copying key ~p\n",[Key])),
  930:     case ?ets_lookup(Stab,Key) of
  931: 	[{?ERASE_MARK(RealKey),_}] ->
  932: 	    %% Only erase if the entry RealKey hasn't been written again
  933: 	    case ?ets_lookup(Stab,RealKey) of
  934: 		[] ->
  935: 		    %% No, it hasn't: we should delete
  936: 		    ?DEBUG(io:format("Erasing: ~p\n",[RealKey])),
  937: 		    ?ets_delete(Dtab,RealKey);
  938: 		_Definition ->
  939: 		    %% It has, don't erase. In this case the new value
  940: 		    %% has already or will soon be written to Dtab
  941: 		    ok
  942: 	    end;
  943: 	[KeyVal] ->
  944: 	    ?DEBUG(io:format("Forwarding: ~p\n",[KeyVal])),
  945: 	    ?ets_insert(Dtab,KeyVal)
  946:     end.
  947: 
  948: %%% DUMP LOADING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  949: 
  950: load_dump(DbName,DumpDir) ->
  951:     case phys_load_dump_ok(DumpDir) of
  952: 	ok ->
  953: 	    Admin = make_admin_table(DbName),
  954: 	    ?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
  955: 	    case phys_load_table(DumpDir,0,Admin) of
  956: 		ok ->
  957: 		    load_dump2(DumpDir,Admin);
  958: 		Other ->
  959: 		    load_dump_failed(Admin,[]),
  960: 		    {error,{load_dump1,Other}}
  961: 	    end;
  962: 	Other ->
  963: 	    {error,{load_dump2,Other}}
  964:     end.
  965: 
  966: load_dump2(DumpDir,Admin) ->
  967:     case ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY) of
  968: 	[{_Key,Classes}] ->
  969: 	    case load_dump_tables(DumpDir,Admin,Classes) of
  970: 		ok ->
  971: 		    {ok, Admin};
  972: 		Other ->
  973: 		    io:format("Dumping failed: ~p\n",[Other]),
  974: 		    load_dump_failed(Admin,Classes)
  975: 	    end;
  976: 	Other ->
  977: 	    io:format("Dumping failed2: ~p\n",[Other]),
  978: 	    load_dump_failed(Admin,[])
  979:     end.
  980: 
  981: load_dump_failed(Admin,[]) ->
  982:     ?ets_delete(Admin),
  983:     {error,load_dump_failed};
  984: load_dump_failed(Admin,[Class|Classes]) ->
  985:     case ?ets_lookup(Admin,Class) of
  986: 	[{_Key,[Tab]}] ->
  987: 	    ?ets_delete(Tab);
  988: 	_ ->
  989: 	    ok
  990:     end,
  991:     load_dump_failed(Admin,Classes).
  992: 
  993: load_dump_tables(_DumpDir,_Admin,[]) ->
  994:     ok;
  995: load_dump_tables(DumpDir,Admin,[Class|Classes]) ->
  996:     Mtab = make_db_table(db_name(Admin),Class),
  997:     ?ets_insert(Admin,{Class,[Mtab]}),
  998:     Num = length(Classes)+1,
  999:     case phys_load_table(DumpDir,Num,Mtab) of
 1000: 	ok ->
 1001: 	    load_dump_tables(DumpDir,Admin,Classes);
 1002: 	Other ->
 1003: 	    {error,{load_dump_failed,Other}}
 1004:     end.
 1005: 
 1006: %%% FILE ACCESS LAYER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 1007: 
 1008: %%% phys_init_dump(Class,DumpDir) -> DumpData
 1009: 
 1010: phys_init_dump(Class,DumpDir,Num) ->
 1011:     ?DEBUG(io:format("Opened ~p for writing\n",[Class])),
 1012:     FileName = [DumpDir,"/etsdump.",integer_to_list(Num)],
 1013:     {tag1,{ok,Fd}} = {tag1,file:open(FileName,write)},
 1014:     {Class,Fd}.
 1015: 
 1016: %%% phys_finish_dump(DumpData) -> NobodyCares
 1017: 
 1018: phys_finish_dump({_Class,Fd}) ->
 1019:     ?DEBUG(io:format("Closed ~p\n",[_Class])),
 1020:     phys_dump_term(Fd,ok),
 1021:     file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
 1022:     ok.
 1023: 
 1024: %%% phys_dump(KeyVal,DumpData) -> NobodyCares
 1025: 
 1026: phys_dump({Key,Val},{_Class,Fd}) ->
 1027:     ?DEBUG(io:format("To disk (~p.dump): {~p,~p}\n",[_Class,Key,Val])),
 1028:     phys_dump_term(Fd,{Key,Val}),
 1029:     ok.
 1030: 
 1031: phys_dump_term(Fd,Term) ->
 1032:     Bin = binary_to_list(term_to_binary(Term)),
 1033:     {tag2,ok} = {tag2,io:put_chars(Fd,encode32(length(Bin)))},
 1034:     {tag3,ok} = {tag3,io:put_chars(Fd,Bin)}.
 1035: 
 1036: %%% phys_ok_dump(DumpDir) -> NobodyCares
 1037: 
 1038: phys_ok_dump(DumpDir) ->
 1039:     ?DEBUG(io:format("Ok:ing dump dir ~s\n",[DumpDir])),
 1040:     FileName = [DumpDir,"/ok"],
 1041:     {tag4,{ok,Fd}} = {tag4,file:open(FileName,write)},
 1042:     {tag5,ok} = {tag5,io:format(Fd,"ok.\n",[])},
 1043:     file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
 1044:     ok.
 1045: 
 1046: phys_remove_ok(DumpDir) ->
 1047:     ?DEBUG(io:format("Removing any Ok in dump dir ~s\n",[DumpDir])),
 1048:     FileName = [DumpDir,"/ok"],
 1049:     %% don't care if delete returns ok, file probably doesn't exist
 1050:     file:delete(FileName),
 1051:     ok.
 1052: 
 1053: phys_load_dump_ok(DumpDir) ->
 1054:     FileName = [DumpDir,"/ok"],
 1055:     case file:consult(FileName) of
 1056: 	{ok,[ok]} ->
 1057: 	    ok;
 1058: 	Other ->
 1059: 	    {error,{consult_error,Other}}
 1060:     end.
 1061: 
 1062: phys_load_table(DumpDir,N,Tab) ->
 1063:     ?DEBUG(io:format("LOAD TABLE ~w\n",[N])),
 1064:     FileName = [DumpDir,"/etsdump.",integer_to_list(N)],
 1065:     case file:open(FileName,read) of
 1066: 	{ok,Fd} ->
 1067: 	    phys_load_entries(Fd,Tab);
 1068: 	Other ->
 1069: 	    {error,{open_error,Other}}
 1070:     end.
 1071: 	    
 1072: phys_load_entries(Fd,Tab) ->
 1073:     case phys_read_len(Fd) of
 1074: 	{ok,Len} ->
 1075: 	    case phys_read_entry(Fd,Len) of
 1076: 		{ok,ok} ->
 1077: 		    ok;
 1078: 		{ok,{Key,Val}} ->
 1079: 		    ?ets_insert(Tab,{Key,Val}),
 1080: 		    phys_load_entries(Fd,Tab);
 1081: 		Other ->
 1082: 		    {error,{read_len,Other}}
 1083: 	    end;
 1084: 	Other ->
 1085: 	    {error,{read_len2,Other}}
 1086:     end.
 1087: 
 1088: phys_read_len(Fd) ->
 1089:     case io:get_chars(Fd,'',4) of
 1090: 	[A,B,C,D] ->
 1091: 	    {ok,decode32(A,B,C,D)};
 1092: 	Other ->
 1093: 	    {error,{decode,Other}}
 1094:     end.
 1095: 
 1096: phys_read_entry(Fd,Len) ->
 1097:     case io:get_chars(Fd,'',Len) of
 1098: 	L when is_list(L), length(L) == Len ->
 1099: 	    {ok,binary_to_term(list_to_binary(L))};
 1100: 	Other ->
 1101: 	    {error,{read_term,Other}}
 1102:     end.
 1103: 
 1104: encode32(N) ->
 1105:     [(N bsr 24) band 255, 
 1106:      (N bsr 16) band 255, 
 1107:      (N bsr 8) band 255,
 1108:      N band 255].
 1109: 
 1110: decode32(A,B,C,D) ->
 1111:     (A bsl 24) bor (B bsl 16) bor (C bsl 8) bor D.
 1112: 
 1113: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%