diff options
Diffstat (limited to 'lib/tv/src/tv_db.erl')
| -rw-r--r-- | lib/tv/src/tv_db.erl | 1271 |
1 files changed, 0 insertions, 1271 deletions
diff --git a/lib/tv/src/tv_db.erl b/lib/tv/src/tv_db.erl deleted file mode 100644 index 75537418b3..0000000000 --- a/lib/tv/src/tv_db.erl +++ /dev/null @@ -1,1271 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2012. 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). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,window,3}}]). - - - --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. |