diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/tv/src/tv_db.erl | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/tv/src/tv_db.erl')
-rw-r--r-- | lib/tv/src/tv_db.erl | 1267 |
1 files changed, 1267 insertions, 0 deletions
diff --git a/lib/tv/src/tv_db.erl b/lib/tv/src/tv_db.erl new file mode 100644 index 0000000000..201b4c0e6b --- /dev/null +++ b/lib/tv/src/tv_db.erl @@ -0,0 +1,1267 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Module handling the internal database in the table tool. +%%% +%%%********************************************************************* + +-module(tv_db). + + + +-export([dbs/2]). + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_db_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +dbs(Master, ErrMsgMode) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + ProcVars = #process_variables{master_pid = Master}, + blocked(ProcVars). + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + +blocked(ProcVars) -> + receive + Msg -> + case Msg of + + #dbs_deblock{} -> + deblock(Msg, ProcVars, false); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + blocked(ProcVars); + + {'EXIT', Pid, Reason} -> + MasterPid = ProcVars#process_variables.master_pid, + exit_signals({Pid, Reason}, MasterPid), + blocked(ProcVars); + + _Other -> + blocked(ProcVars) + end + end. + + + + + + + +deblock(Msg, ProcVars, SearchWinCreated) -> + #dbs_deblock{sender = Sender, + etsread_pid = EtsreadPid, + type = Type, + keypos = KeyPos, + sublist_length = SublistLength} = Msg, + + NewDbData = #db_data{subset_size = SublistLength, + subset_pos = 1, + key_no = KeyPos, + ets_type = Type + }, + NewProcVars = ProcVars#process_variables{db_data = NewDbData, + etsread_pid = EtsreadPid}, + Sender ! #dbs_deblock_cfm{sender = self()}, + deblocked_loop(NewProcVars, SearchWinCreated, [], undefined). + + + + + + + + +deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp) -> + receive + Msg -> + case Msg of + + {gs,entry,keypress,_Data,['Return' | _T]} -> + NewSearchData = search_object(ProcVars, RegExp), + deblocked_loop(ProcVars, SearchWinCreated, NewSearchData, RegExp); + + {gs,entry,keypress,_Data,['Tab' | _T]} -> + gs:config(entry, [{select, {0,1000}}]), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,entry,keypress,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,expr_term,click,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, false); + + {gs,expr_regexp,click,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, true); + + {gs,search,click,_Data,_Args} -> + NewSearchData = search_object(ProcVars, RegExp), + deblocked_loop(ProcVars, SearchWinCreated, NewSearchData, RegExp); + + {gs,cancel,click,cancel,_Args} -> + tv_db_search:destroy_window(SearchWinCreated), + deblocked_loop(ProcVars, false, [], RegExp); + + {gs,listbox,click,_LbData,[Idx | _T]} when SearchData =/= [] -> + tv_db_search:mark_busy(SearchWinCreated), + {Row,_Obj} = lists:nth(Idx+1, SearchData), + DbData = ProcVars#process_variables.db_data, + %% Never allow 'subset_pos' to have zero as value! + %% No list can begin with the 0:th element!!! + %% Has to be at least 1! + NewDbData = DbData#db_data{subset_pos=?COMM_FUNC_FILE:max(1, + Row), + subset_size=?ITEMS_TO_DISPLAY}, + NewProcVars = ProcVars#process_variables{db_data=NewDbData}, + send_subset(NewProcVars, undefined, undefined), + tv_db_search:mark_nonbusy(SearchWinCreated), + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,win,configure,_Data,_Args} -> + tv_db_search:resize_window(SearchWinCreated), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,win,destroy,_Data,_Args} -> + deblocked_loop(ProcVars, false, [], RegExp); + + + #dbs_new_data{data = NewData, keys = ListOfKeys, + time_to_read_table = ElapsedTimeEtsread} -> + tv_db_search:reset_window(SearchWinCreated), + T1 = time(), + NewProcVars = update_db(NewData, ListOfKeys, ProcVars), + T2 = time(), + ElapsedTimeDbs = compute_elapsed_seconds(T1, T2), + send_subset(NewProcVars, ElapsedTimeEtsread, ElapsedTimeDbs), + deblocked_loop(NewProcVars, SearchWinCreated, [], RegExp); + + #dbs_subset_req{subset_pos = Pos,subset_length = Length} -> + DbData = ProcVars#process_variables.db_data, + %% Never allow 'subset_pos' to have zero as value! + %% No list can begin with the 0:th element!!! + %% Has to be at least 1! + NewDbData = DbData#db_data{subset_pos=?COMM_FUNC_FILE:max(1, + Pos), + subset_size=Length}, + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + send_subset(NewProcVars, undefined, undefined), + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_marked_row{row_no = RowNo} -> + DbData = ProcVars#process_variables.db_data, + NewDbData = DbData#db_data{requested_row = RowNo}, + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_search_req{} -> + tv_db_search:create_window(SearchWinCreated), + deblocked_loop(ProcVars, true, SearchData, false); + + #dbs_sorting_mode{} -> + {NewProcVars, NewSearchData} = + update_sorting_mode(Msg, ProcVars, + SearchWinCreated, SearchData, RegExp), + deblocked_loop(NewProcVars, SearchWinCreated, NewSearchData, RegExp); + + #dbs_deblock{} -> + tv_db_search:reset_window(SearchWinCreated), + deblock(Msg, ProcVars, SearchWinCreated); + + #dbs_updated_object{object=Obj,old_object=OldObj,old_color=Color,obj_no=ObjNo} -> + {Success, NewProcVars} = update_object(Obj, OldObj, Color, ObjNo, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_new_object{object=Obj} -> + {Success, NewProcVars} = new_object(Obj, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_delete_object{object=Obj, color=Color, obj_no=ObjNo} -> + {Success, NewProcVars} = delete_object(Obj, Color, ObjNo, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #pc_list_info{lists_as_strings=ListAsStr} -> + NewProcVars = ProcVars#process_variables{lists_as_strings=ListAsStr}, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {'EXIT', Pid, Reason} -> + MasterPid = ProcVars#process_variables.master_pid, + exit_signals({Pid, Reason}, MasterPid), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + _Other -> + %% io:format("Received message: ~w ~n", [_Other]), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp) + end + end. + + + + + + + +search_object(ProcVars, RegExp) -> + DbData = ProcVars#process_variables.db_data, + DbList = dblist2list(DbData#db_data.db), + ListAsStr = ProcVars#process_variables.lists_as_strings, + case catch tv_db_search:get_input_and_search(DbList, RegExp, ListAsStr) of + {'EXIT', _Reason} -> + tv_db_search:reset_window(true), + []; + List -> + List + end. + + + + + + +update_sorting_mode(Msg, ProcVars, SearchWinCreated, OldSearchData, RegExp) -> + #dbs_sorting_mode{sorting = Sorting, + reverse = Reverse, + sort_key_no = SortKeyNo} = Msg, + + DbData = ProcVars#process_variables.db_data, + + #db_data{db = DbList, + sorting = OldSorting, + rev_sorting = OldReverse, + sort_key_no = OldSortKeyNo} = DbData, + + + NewDbList = sort_db_list(DbList, Sorting, OldSorting, Reverse, OldReverse, + SortKeyNo, OldSortKeyNo), + + NewDbData = DbData#db_data{db = NewDbList, + sorting = Sorting, + rev_sorting = Reverse, + sort_key_no = SortKeyNo + }, + + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + send_subset(NewProcVars, undefined, undefined), + + SearchData = + case Sorting of + false -> + OldSearchData; + OldSorting when Reverse =:= OldReverse, + SortKeyNo =:= OldSortKeyNo -> + []; + OldSorting when Reverse =:= OldReverse, + OldSortKeyNo =:= undefined-> + []; + _Other -> + ListAsStr = ProcVars#process_variables.lists_as_strings, + case catch tv_db_search:update_search(SearchWinCreated, + NewDbList, RegExp, + ListAsStr) of + {'EXIT', _Reason} -> + tv_db_search:reset_window(true), + []; + List -> + List + end + end, + + {NewProcVars, SearchData}. + + + + + + + + +sort_db_list(DbList, Sort, Sort, Rev, Rev, KeyNo, KeyNo) -> + % Already sorted! + DbList; +sort_db_list(DbList, false, _OldSort, _Rev, _OldRev, _KeyNo, _OldKeyNo) -> + % No sorting, i.e., the old list order suffices! + DbList; +sort_db_list(DbList, _Sort, _OldSort, Rev, _OldRev, KeyNo, _OldKeyNo) -> + tv_db_sort:mergesort(KeyNo, DbList, Rev). + + + + + + + +send_subset(ProcVars, EtsreadTime, DbsTime) -> + #process_variables{master_pid = MasterPid, + db_data = DbData, + list_of_keys = ListOfKeys} = ProcVars, + + #db_data{subset_size = SubsetSize, + subset_pos = SubsetPos, + requested_row = RowNo, + db_size = DbSize, + db = DbList, + max_elem_size = MaxElemSize} = DbData, + + + RowData = get_requested_row_data(RowNo, DbList), + + if + DbSize > 0 -> + Pos = ?COMM_FUNC_FILE:min(SubsetPos, DbSize), + % Requested_data may be shorter than requested, but that's OK, + % pd handles that correctly! + Subset = lists:sublist(DbList, Pos, SubsetSize), + MasterPid ! #dbs_subset{sender = self(), + data = Subset, + subset_pos = Pos, + db_length = DbSize, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + requested_row = RowData, + required_time_etsread = EtsreadTime, + required_time_dbs = DbsTime + }; + true -> + MasterPid ! #dbs_subset{sender = self(), + data = [], + subset_pos = 1, + db_length = 0, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + requested_row = RowData, + required_time_etsread = EtsreadTime, + required_time_dbs = DbsTime + } + end. + + + + + +get_requested_row_data(undefined, _DbList) -> + []; +get_requested_row_data(_RowNo, []) -> + []; +get_requested_row_data(RowNo, DbList) -> + case catch lists:nth(RowNo, DbList) of + {'EXIT', _Reason} -> + []; + RowData -> + [RowData] + end. + + + + +exit_signals(ExitInfo, MasterPid) -> + case ExitInfo of + {MasterPid, _Reason} -> + % When from master, just quit! + exit(normal); + _Other -> + done + end. + + + + +update_db(NewList, ListOfKeys, ProcVars) -> + DbData = ProcVars#process_variables.db_data, + #db_data{db = OldDbList, + max_elem_size = MaxElemSize, + deleted = DelList, + ets_type = EtsType, + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + DbList = update_colors(OldDbList -- DelList), + OldList = dblist2list(DbList), + InsOrUpd = (NewList -- OldList), + DelOrUpd = (OldList -- NewList), + + {Inserted, Deleted, Updated} = group_difflists(basetype(EtsType), KeyNo, + InsOrUpd, + DelOrUpd), + DelMarked = mark_deleted(KeyNo, Deleted, DbList), + Replaced = replace_elements(KeyNo, Updated, DelMarked), + NewDbList = add_elements(KeyNo, Inserted, Replaced, Sorting, RevSorting, + SortKeyNo), + + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, + ?COMM_FUNC_FILE:max(max_size(Replaced), + max_size(Inserted))), + + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize, + deleted = list2dblist(Deleted, ?BLACK) + }, + + ProcVars#process_variables{db_data = NewDbData, + list_of_keys = ListOfKeys + }. + + + + + + +update_object(Obj, OldObj, OldColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{key_no = KeyNo} = DbData, + + %% Don't update if there are no changes! + case OldObj of + Obj when OldColor =/= ?BLACK -> %% Allow deleted objects to be inserted! + gs:window(dbwin, gs:start(), []), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", ["The object is unchanged!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Stay the patient course,", + "Of little worth is your ire:", + "The object's unchanged." ]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + _Other -> + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + Result = + case OldColor of + ?BLACK -> + EtsreadPid ! #etsread_new_object{sender = self(), + object = Obj}, + receive + #etsread_new_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end; + _OtherColor -> + EtsreadPid ! #etsread_update_object{sender = self(), + key_no = KeyNo, + object = Obj, + old_object = OldObj}, + receive + #etsread_update_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end + end, + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + {true, update_object2(Obj, OldObj, OldColor, ObjNo, ProcVars)} + end + end. + + + + + +update_object2(Obj, OldObj, OldColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData} = ProcVars, + + #db_data{db = DbList, + ets_type = EtsType, %% 'bag', 'set', 'ordered_set' or + %% 'duplicate_bag' + max_elem_size = MaxElemSize, + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + %% Replace the old element... + Key = element(KeyNo, Obj), + OldKey = element(KeyNo, OldObj), + %% If Key == OldKey, the old object shall only be replaced! + %% Otherwise the updated object shall be treated as a new + %% object when inserting it in the list! + %% In that latter case, we also have to check for duplicates! + + Fun = + case basetype(EtsType) of + set -> + case Key of + OldKey -> + fun({Data,Color}, {Replaced,AccDb}) when element(KeyNo,Data) =/= Key -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) -> + ElemKey = element(KeyNo,Data), + case ElemKey of + OldKey when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + OldKey when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + OldKey -> + {Replaced, AccDb}; + Key -> + {Replaced, AccDb}; + _OtherKey -> + {Replaced, [{Data,Color} | AccDb]} + end + end + end; + + bag -> + case Key of + OldKey -> + fun({Data,_Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, AccDb}; + ({Data,Color}, {Replaced,AccDb}) when Data =/= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + %% Clauses when Data =:= OldObj. + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({Data,_Color}, {Replaced,AccDb}) when Data =:= OldObj -> + {Replaced, AccDb}; + ({Data,_Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, AccDb}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end + end; + + duplicate_bag -> + %% Multiple identical objects allowed, meaning that we shall not + %% remove anything, just replace one element. + case Key of + OldKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =/= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end + end + end, + + FilterFun = fun(Acc0, L) -> + lists:foldl(Fun, Acc0, L) + end, + + + {Repl, TmpList} = + case split(ObjNo, DbList) of + {L1, [{OldObj,OldColor} | T]} when OldColor =/= ?BLACK -> + {true, + lists:reverse(element(2, FilterFun({true,[]}, L1))) ++ + [{Obj,?GREEN1} | lists:reverse(element(2, FilterFun({true,[]},T)))]}; + {L1, [{OldObj,OldColor} | T]} -> + {true, + lists:reverse(element(2, FilterFun({true,[]}, L1))) ++ + [{Obj,?RED1} | lists:reverse(element(2, FilterFun({true,[]}, T)))]}; + {L1, L2} -> + {R1, NewL1} = FilterFun({false,[]}, L1), + {R2, NewL2} = FilterFun({false,[]}, L2), + {R1 or R2, lists:reverse(NewL1) ++ lists:reverse(NewL2)} + end, + + NewDbList = + case Repl of + true when not Sorting -> + TmpList; + true -> + tv_db_sort:mergesort(SortKeyNo, TmpList, RevSorting); + false -> + TmpList2 = + case Key of + OldKey -> + lists:reverse(element(2, FilterFun({false,[]}, TmpList))); + _OtherKey -> + lists:reverse(element(2, FilterFun({true,[]}, TmpList))) ++ + [{Obj,?RED1}] + end, + case Sorting of + false -> + TmpList2; + true -> + tv_db_sort:mergesort(SortKeyNo, TmpList2, RevSorting) + end + end, + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, max_size([Obj])), + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize + }, + ProcVars#process_variables{db_data = NewDbData}. + + + + + +delete_object(_Obj, ?BLACK, _ObjNo, ProcVars) -> + %% Don't delete already deleted objects!!! + {false, ProcVars}; +delete_object(undefined, undefined, _ObjNo, ProcVars) -> + {false, ProcVars}; +delete_object(Obj, _ObjColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{db = DbList, + deleted = OldDeleted} = DbData, + + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + EtsreadPid ! #etsread_delete_object{sender = self(), + object = Obj}, + Result = + receive + #etsread_delete_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end, + + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + %% Replace the old element... + %% Have to beware of duplicate_bag tables, + %% i.e., the same object may occur more than + %% once, but we only want to remove it once! + {Repl, TmpList} = + case split(ObjNo, DbList) of + {L1, [{Obj,_Color} | T]} -> + {true, L1 ++ [{Obj,?BLACK} | T]}; + {L1, L2} -> + {false, L1 ++ L2} + end, + NewDbList = + case Repl of + true -> + TmpList; + false -> + Fun = fun({Data,TmpColor}, + {Removed,AccDb}) when Data =/= Obj -> + {Removed, [{Data,TmpColor} | AccDb]}; + ({_Data,TmpColor}, + {Removed,AccDb}) when not Removed, TmpColor =/= ?BLACK -> + {true, [{Obj,?BLACK} | AccDb]}; + ({Data,TmpColor}, + {Removed,AccDb}) -> + {Removed, [{Data,TmpColor} | AccDb]} + end, + lists:reverse(element(2, lists:foldl(Fun, {false,[]}, DbList))) + end, + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + deleted = [{Obj,?BLACK} | OldDeleted]}, + {true, ProcVars#process_variables{db_data = NewDbData}} + end. + + + + + +new_object(Obj, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{db = DbList, + max_elem_size = MaxElemSize, + ets_type = EtsType, %% 'bag', 'set' or 'duplicate_bag' + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + EtsreadPid ! #etsread_new_object{sender = self(), + object = Obj}, + Result = + receive + #etsread_new_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end, + + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + Key = element(KeyNo, Obj), + NewDbList = insert_new_object(EtsType, Key, KeyNo, Obj, DbList, Sorting, + RevSorting, SortKeyNo), + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, max_size([Obj])), + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize + }, + {true, ProcVars#process_variables{db_data = NewDbData}} + end. + + + + + +insert_new_object(EtsType,Key,KeyNo,Obj,DbList,Sorting,RevSorting,SortKeyNo) -> + %% Remove elements from the list that ought not to be there, + %% according to the table type! + + Fun = + case basetype(EtsType) of + set -> + fun({Data,Color}, {Replaced,AccDb}) when element(KeyNo,Data) =/= Key -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK, + Data =/= Obj-> + {true, [{Obj,?GREEN1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =:= ?BLACK -> + {true, [{Obj, ?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =:= ?BLACK -> + {false, AccDb}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + bag -> + fun({Data,Color}, {Replaced,AccDb}) when Data =/= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =/= ?BLACK -> + {true, AccDb}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =:= ?BLACK -> + {true, AccDb}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =:= ?BLACK -> + {true, [{Obj, ?RED1} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + duplicate_bag -> + %% The fun is never called if the type is duplicate_bag, + %% because all we have to do with new elements is to insert + %% them (multiple identical objects allowed). + not_used + end, + + FilterFun = fun(Acc0, L) -> + lists:foldl(Fun, Acc0, L) + end, + + {_Replaced, TmpDbList} = + case EtsType of + duplicate_bag -> + {false, DbList}; + _OtherType -> + {R,L} = FilterFun({false,[]}, DbList), + {R, lists:reverse(L)} + end, + + case Sorting of + false -> + TmpDbList ++ [{Obj,?RED1}]; + true -> + %% The original list is already sorted! + %% Just merge the two lists together! + tv_db_sort:merge(SortKeyNo, TmpDbList, [{Obj,?RED1}], RevSorting) + end. + + + + + + +max_size([]) -> + 0; +max_size(L) -> + max_size(L, 0). + + + +max_size([], CurrMax) -> + CurrMax; +max_size([H | T], CurrMax) when is_tuple(H) -> + Size = size(H), + if + Size >= CurrMax -> + max_size(T, Size); + true -> + max_size(T, CurrMax) + end; +max_size([_H | T], CurrMax) -> + Size = 1, + if + Size >= CurrMax -> + max_size(T, Size); + true -> + max_size(T, CurrMax) + end. + + + + + +add_elements(_KeyNo, Inserted, List, false, _RevSorting, _SortKeyNo) -> + % Remember that the order of the original list has to be preserved! + List ++ list2dblist(Inserted, ?RED1); +add_elements(_KeyNo, Inserted, List, _Sorting, RevSorting, SortKeyNo) -> + % The original list is already sorted - sort the new elements, and + % just merge the two lists together! + SortedInsertedList = tv_db_sort:mergesort(SortKeyNo, + list2dblist(Inserted, ?RED1), + RevSorting), + tv_db_sort:merge(SortKeyNo, List, SortedInsertedList, RevSorting). + + + + + + %% We assume the list already has been sorted, i.e., since the order won't + %% be changed by marking an element deleted, we DON'T have to sort the list + %% once again! + +mark_deleted(_KeyNo, [], List) -> + List; +mark_deleted(KeyNo, [Data | T], List) -> + KeyValue = tv_db_sort:get_compare_value(KeyNo, Data), + NewList = mark_one_element_deleted(KeyNo, KeyValue, Data, List, []), + mark_deleted(KeyNo, T, NewList). + + + + + + + + +mark_one_element_deleted(_KeyNo, _KeyValue, _Data, [], Acc) -> + Acc; +mark_one_element_deleted(KeyNo, {tuple, KeyValue}, + Data, [{DataTuple, Color} | Tail], Acc) -> + OldKeyValue = tv_db_sort:get_compare_value(KeyNo, DataTuple), + % Remember that the order of the original list has to be preserved! + if + OldKeyValue =:= {tuple, KeyValue} -> + Acc ++ [{Data, ?BLACK}] ++ Tail; + true -> + mark_one_element_deleted(KeyNo, {tuple, KeyValue}, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end; +mark_one_element_deleted(KeyNo, _KeyValue, Data, [{DataTuple, Color} | Tail], Acc) -> + if + Data =:= DataTuple -> + Acc ++ [{Data, ?BLACK}] ++ Tail; + true -> + mark_one_element_deleted(KeyNo, _KeyValue, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end. + + + + + + + + %% We assume the list already has been sorted, i.e., since the order won't + %% be changed by marking an element updated, we DON'T have to sort the list + %% once again! + +replace_elements(_KeyNo, [], List) -> + List; +replace_elements(KeyNo, [Data | T], List) -> + KeyValue = tv_db_sort:get_compare_value(KeyNo, Data), + NewList = replace_one_element(KeyNo, KeyValue, Data, List, []), + replace_elements(KeyNo, T, NewList). + + + + + + + +replace_one_element(_KeyNo, _Key, _Data, [], Acc) -> + Acc; +replace_one_element(KeyNo, {tuple, Key1}, Data, [{DataTuple, Color} | Tail], Acc) -> + Key2 = tv_db_sort:get_compare_value(KeyNo, DataTuple), + % Remember that the order of the original list has to be preserved! + if + Key2 =:= {tuple, Key1} -> + Acc ++ [{Data, ?GREEN1}] ++ Tail; + true -> + replace_one_element(KeyNo, {tuple, Key1}, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end; +replace_one_element(_KeyNo, _KeyValue, _Data, [{DataTuple, Color} | Tail], Acc) -> + % Can't replace an element with no key! + Acc ++ [{DataTuple, Color} | Tail]. + + + + + + + + +group_difflists(bag, _KeyNo, Inserted, Deleted) -> + %% Since the ETS table is of bag type, no element can be updated, i.e., + %% it can only be deleted and re-inserted, otherwise a new element will be added. + {Inserted, Deleted, []}; +group_difflists(duplicate_bag, _KeyNo, Inserted, Deleted) -> + %% Since the ETS table is of duplicate_bag type, no element can be updated, i.e., + %% it can only be deleted and re-inserted, otherwise a new element will be added. + {Inserted, Deleted, []}; +group_difflists(set, _KeyNo, [], Deleted) -> + %% Updated elements have to be present in both lists, i.e., if one list is empty, + %% the other contains no updated elements - they are either inserted or deleted! + {[], Deleted, []}; +group_difflists(set, _KeyNo, Inserted, []) -> + {Inserted, [], []}; +group_difflists(set, KeyNo, InsOrUpd, DelOrUpd) -> + match_difflists(KeyNo, InsOrUpd, DelOrUpd, [], []). + + + + + + +match_difflists(_KeyNo, [], Deleted, Inserted, Updated) -> + {Inserted, Deleted, Updated}; +match_difflists(KeyNo, [Data | T], DelOrUpd, InsAcc, UpdAcc) -> + % This function is only called in case of a 'set' ETS table. + % 'Set' type of ETS table means there are unique keys. If two elements in + % InsOrUpd and DelOrUpd have the same key, that element has been updated, + % and is added to the Updated list, and removed from the original two lists. + % After the two lists have been traversed in this way, the remaining elements + % in DelOrUpd forms the new Deleted list (analogous for InsOrUpd). + % If we want to improve the performance, we could check which list is the + % shortest, since the traversing time depends on this. + Key = element(KeyNo, Data), + case searchdelete(Key, KeyNo, DelOrUpd) of + {true, NewDelOrUpd} -> + match_difflists(KeyNo, T, NewDelOrUpd, InsAcc, [Data | UpdAcc]); + {false, SameDelOrUpd} -> + match_difflists(KeyNo, T, SameDelOrUpd, [Data | InsAcc], UpdAcc) + end. + + + + +searchdelete(_Key, _ElemNo, []) -> + {false, []}; +searchdelete(Key, ElemNo, List) -> + searchdelete(Key, ElemNo, List, []). + + + + + +searchdelete(_Key, _ElemNo, [], Acc) -> + {false, Acc}; +searchdelete(Key, ElemNo, [Tuple | Tail], Acc) -> + % We don't use standard libraries, 'cause we want to make an 'atomic' + % operation, i.e., we will not search the list two times... + case (element(ElemNo, Tuple) =:= Key) of + true -> + {true, Acc ++ Tail}; % Return the list without the matching element + _Other -> + searchdelete(Key, ElemNo, Tail, [Tuple | Acc]) + end. + + + + + + + +dblist2list([]) -> + []; +dblist2list([{Data, _Color} | T]) -> + [Data | dblist2list(T)]. + + + + + + + +list2dblist([], _Color) -> + []; +list2dblist([Data | T], Color) -> + [{Data, Color} | list2dblist(T, Color)]. + + + + + + + + +update_colors([]) -> + []; +update_colors([{Data, Color} | T]) -> + [{Data, new_color(Color)} | update_colors(T)]. + + + + + + + + +new_color(?GREEN1) -> + ?GREEN2; +new_color(?GREEN2) -> + ?GREEN3; +new_color(?GREEN3) -> + ?GREEN4; +new_color(?GREEN4) -> + ?GREEN5; +new_color(?GREEN5) -> + ?DEFAULT_BTN_COLOR; +new_color(?RED1) -> + ?RED2; +new_color(?RED2) -> + ?RED3; +new_color(?RED3) -> + ?RED4; +new_color(?RED4) -> + ?RED5; +new_color(?RED5) -> + ?DEFAULT_BTN_COLOR; +new_color(_Other) -> + ?DEFAULT_BTN_COLOR. % Default shall be gray. + + + + + + + + +compute_elapsed_seconds({H1, M1, S1}, {H2, M2, S2}) -> + ElapsedHours = get_time_diff(hours, H1, H2), + ElapsedMinutes = get_time_diff(minutes, M1, M2), + ElapsedSeconds = get_time_diff(seconds, S1, S2), + (ElapsedHours * 3600) + (ElapsedMinutes * 60) + ElapsedSeconds + 1. + + + + + + + +get_time_diff(_Type, T1, T2) when T1 =< T2 -> + T2 - T1; +get_time_diff(hours, T1, T2) -> + T2 + 24 - T1; +get_time_diff(minutes, T1, T2) -> + T2 + 60 - T1; +get_time_diff(seconds, T1, T2) -> + T2 + 60 - T1. + + + + +split(_N, []) -> + {[], []}; +split(0, List) -> + {[], List}; +split(N, List) -> + split2(0, N - 1, [], List). + + + +split2(Ctr, N, Acc, [H | T]) when Ctr < N -> + split2(Ctr + 1, N, [H | Acc], T); +split2(_Ctr, _N, Acc, []) -> + {lists:reverse(Acc), []}; +split2(_Ctr, _N, Acc, List) -> + {lists:reverse(Acc), List}. + +basetype(ordered_set) -> + set; +basetype(Any) -> + Any. |