tv_db.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,268 行 · 第 1/3 页

    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)