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: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%