[erlang-questions] extended timer module to handle absolute time-of-day timers

Serge Aleynikov <>
Wed Jan 14 04:04:01 CET 2009


Since you are using the timed_supervisor, I'll post an updated version 
to trapexit that fixes some bugs within the week or so.

Serge

Michael McDaniel wrote:
>  Thanks - I like it.  Just as I like timed_supervisor.erl which I use
>  everyday (strictly speaking, it's always running!).
> 
>  I think the new functions would be useful additions to the
>  OTP included timer module.
> 
> 
> ~Michael
> 
> 
> On Mon, Jan 12, 2009 at 11:48:27PM -0500, Serge Aleynikov wrote:
>> Sorry - previous email had a wrong attachment.
>>
>>
>> I extended the timer module to handle absolute time specifications.
>>
>> With this implementation it's possible to have messages sent on given
>> days of week at a certain time of day.  Five new functions are added:
>>      apply_at_local_time/4, send_at_local_time/3, exit_at_local_time/3,
>>      apply_daily_at_local_time/5, send_daily_at_local_time/4.
>>
>>
>> Example1: Send a shutdown message to Pid at 23:00:00 every Friday and
>> Sunday.
>>      timer:send_daily_at_local_time([fri,sun], {23,0,0}, Pid, shutdown).
>>
>> Example2: Send a restart message to Pid at "6:00:00":
>>      timer:send_at_local_time({6,0,0}, Pid, restart).
>>
>> Legacy timer_server's functionality is not affected.
>>
>> The rationale behind this extension is that I frequently needed
>> functionality to schedule some "cron-like" recurrent activities, and was
>> always relying either on cron+erl_call or coding that activity with help
>> of timer:send_after/3 or timer:send_interval/2.  As I finally got sick
>> of dealing with shortcomings of the timer module, I put together this
>> extension.
>>
>> Let me know if you also find it useful, and in such case perhaps we can
>> get it included in the OTP.
>>
>> Serge
>>
> 
>> %% ``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 via the world wide web 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.
>> %%
>> %% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
>> %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
>> %% AB. All Rights Reserved.''
>> %%
>> %% Contributor: Serge Aleynikov <>
>> %%  12-Jan-2009 Added support for absolute time timers including:
>> %%      apply_at_local_time/4, send_at_local_time/3, exit_at_local_time/3,
>> %%      apply_daily_at_local_time/5, send_daily_at_local_time/4
>> %%
>> %%     $Id$
>> %%
>> -module(timer).
>>
>> -export([apply_after/4,
>> 	 send_after/3, send_after/2,
>> 	 exit_after/3, exit_after/2, kill_after/2, kill_after/1,
>> 	 apply_interval/4, send_interval/3, send_interval/2,
>>      apply_at_local_time/4, send_at_local_time/3,
>>      exit_at_local_time/3, kill_at_local_time/2,
>>      apply_daily_at_local_time/5, send_daily_at_local_time/4,
>> 	 cancel/1, sleep/1, tc/3, now_diff/2,
>> 	 seconds/1, minutes/1, hours/1, hms/3]).
>>
>> -export([start_link/0, start/0,
>> 	 handle_call/3,  handle_info/2,
>> 	 init/1,
>> 	 code_change/3, handle_cast/2, terminate/2]).
>>
>> %% internal exports for test purposes only
>> -export([get_status/0]).
>>
>> %% Max
>> -define(MAX_TIMEOUT, 16#0800000).
>> -define(TIMER_TAB, timer_tab).
>> -define(INTERVAL_TAB, timer_interval_tab).
>>
>> %%
>> %% Interface functions
>> %%
>> %% Time is in milliseconds.
>> %% TimeOfDay is in time() format (e.g. {3,59,15} = "03:59:15")
>> %%
>> apply_at_local_time(TimeOfDay, M, F, A) ->
>>     req(apply_at_local_time, {TimeOfDay, {M, F, A}}).
>>
>> apply_after(Time, M, F, A) ->
>>     req(apply_after, {Time, {M, F, A}}).
>>
>> send_at_local_time(TimeOfDay, Pid, Message) ->
>>     req(apply_at_local_time, {TimeOfDay, {?MODULE, send, [Pid, Message]}}).
>>
>> send_after(Time, Pid, Message) ->
>>     req(apply_after, {Time, {?MODULE, send, [Pid, Message]}}).
>>
>> send_after(Time, Message) ->
>>     send_after(Time, self(), Message).
>>
>> exit_at_local_time(TimeOfDay, Pid, Reason) ->
>>     req(apply_at_local_time, {TimeOfDay, {erlang, exit, [Pid, Reason]}}).
>>
>> exit_after(Time, Pid, Reason) ->
>>     req(apply_after, {Time, {erlang, exit, [Pid, Reason]}}).
>>
>> exit_after(Time, Reason) ->
>>     exit_after(Time, self(), Reason).
>>
>> kill_at_local_time(TimeOfDay, Pid) ->
>>     exit_at_local_time(TimeOfDay, Pid, kill).
>>
>> kill_after(Time, Pid) ->
>>     exit_after(Time, Pid, kill).
>>
>> kill_after(Time) ->
>>     exit_after(Time, self(), kill).
>>
>> %% @spec (DaysOfWeek, TimeOfDay::time(), M, F, A) ->
>> %%              {ok, TRef::ref()} | {error, Reason}
>> %%          DaysOfWeek = [DayOfWeek]
>> %%          DayOfWeek  = integer() | sun | mon | tue | wed | thu | fri | sat
>> apply_daily_at_local_time(DaysOfWeek, TimeOfDay, M, F, A) ->
>>     req(apply_daily_at_local_time, {DaysOfWeek, TimeOfDay, self(), {M, F, A}}).
>>
>> apply_interval(Time, M, F, A) ->
>>     req(apply_interval, {Time, self(), {M, F, A}}).
>>
>> %% @spec (DaysOfWeek, TimeOfDay::time(), Pid::pid(), M, F, A) ->
>> %%              {ok, TRef::ref()} | {error, Reason}
>> %%          DaysOfWeek = [DayOfWeek]
>> %%          DayOfWeek  = integer() | sun | mon | tue | wed | thu | fri | sat
>> send_daily_at_local_time(DaysOfWeek, TimeOfDay, Pid, Message) ->
>>     Details = {?MODULE, send, [Pid, Message]},
>>     req(apply_daily_at_local_time, {DaysOfWeek, TimeOfDay, Pid, Details}).
>>
>> send_interval(Time, Pid, Message) ->
>>     req(apply_interval, {Time, Pid, {?MODULE, send, [Pid, Message]}}).
>>
>> send_interval(Time, Message) ->
>>     send_interval(Time, self(), Message).
>>
>> cancel(BRef) ->
>>     req(cancel, BRef).
>>
>> sleep(T) ->
>>     receive
>>     after T -> ok
>>     end.
>>
>> %%
>> %% Measure the execution time (in microseconds) for an MFA.
>> %%
>> tc(M, F, A) ->
>>     Before = erlang:now(),
>>     Val = (catch apply(M, F, A)),
>>     After = erlang:now(),
>>     {now_diff(After, Before), Val}.
>>
>> %%
>> %% Calculate the time difference (in microseconds) of two
>> %% erlang:now() timestamps, T2-T1.
>> %%
>> now_diff({A2, B2, C2}, {A1, B1, C1}) ->
>>     ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1.
>>
>> %%
>> %% Convert seconds, minutes etc. to milliseconds.
>> %%
>> seconds(Seconds) ->
>>     1000*Seconds.
>> minutes(Minutes) ->
>>     1000*60*Minutes.
>> hours(Hours) ->
>>     1000*60*60*Hours.
>> hms(H, M, S) ->
>>     hours(H) + minutes(M) + seconds(S).
>>
>> %%
>> %%   Start/init functions
>> %%
>>
>> %%   Start is only included because of backward compatibility!
>> start() ->
>>     ensure_started().
>>
>> start_link() ->
>>     gen_server:start_link({local, timer_server}, ?MODULE, [], []).
>>
>> init([]) ->
>>     process_flag(trap_exit, true),
>>     ets:new(?TIMER_TAB,[named_table,ordered_set,protected]),
>>     ets:new(?INTERVAL_TAB,[named_table,protected]),
>>     {ok, [], infinity}.
>>
>> ensure_started() ->
>>     case whereis(timer_server) of
>> 	undefined ->
>> 	    C = {timer_server, {?MODULE, start_link, []}, permanent, 1000,
>> 		 worker, [?MODULE]},
>> 	    supervisor:start_child(kernel_safe_sup, C),  % kernel_safe_sup
>> 	    ok;
>> 	_ -> ok
>>     end.
>>
>> %% server calls
>>
>> req(Req, Arg) ->
>>     SysTime = now(),
>>     ensure_started(),
>>     gen_server:call(timer_server, {Req, Arg, SysTime}, infinity).
>>
>> %%
>> %% handle_call(Request, From, Timers) ->
>> %%  {reply, Response, Timers, Timeout}
>> %%
>> %% Time and Timeout is in milliseconds. WhenStarted is in now() format.
>> %% Started is in microseconds.
>> %%
>> handle_call({apply_after, {Time, Op}, WhenStarted}, _From, _Ts)
>>   when is_integer(Time), Time >= 0 ->
>>     Started = system_time(WhenStarted),
>>     BRef = {Started + 1000*Time, make_ref()},
>>     Timer = {BRef, timeout, Op},
>>     ets:insert(?TIMER_TAB, Timer),
>>     Timeout = timer_timeout(now()),
>>     {reply, {ok, BRef}, [], Timeout};
>>
>> handle_call({apply_at_local_time, {{H,M,S} = _Time, Op}, WhenStarted}, From, Ts)
>>   when is_integer(H), H >= 0, H < 24
>>      , is_integer(M), M >= 0, M < 61
>>      , is_integer(S), S >= 0, S < 61
>> ->
>>     {_, {H1,M1,S1}} = calendar:now_to_local_time(WhenStarted),
>>     Interval = hms(H-H1, M-M1, S-S1),
>>     if Interval < 0 ->
>> 	    {reply, {error, expired}, [], next_timeout()};
>>     true ->
>>         handle_call({apply_after, {Interval, Op}, WhenStarted}, From, Ts)
>>     end;
>>
>> handle_call({apply_daily_at_local_time, {DaysOfWeek, {H,M,S} = Time, To, MFA}, WhenStarted}, _From, _Ts)
>>   when is_integer(H), H >= 0, H < 24
>>      , is_integer(M), M >= 0, M < 61
>>      , is_integer(S), S >= 0, S < 61
>>      , is_list(DaysOfWeek)
>> ->
>>     try
>>         DaysOfWeek =:= [] andalso throw(badarg),
>>         %% Represent days of week
>>         %% as a 7-element tuple with 1's being the days of week
>>         %% when to fire the timer and 0's when not to fire.
>>         DOWs = lists:foldl(fun(I, T) -> setelement(I, T, 1) end,
>>                     erlang:make_tuple(7, 0), [to_dow(D) || D <- DaysOfWeek]),
>>         {Date, Started} = calendar:now_to_local_time(WhenStarted),
>>         DOW = calendar:day_of_the_week(Date),
>>         Interval = dow_interval(DOWs, DOW, Time, Started, 0),
>>         %% To must be a pid or a registered name
>>         Pid = get_pid(To),
>>         is_pid(Pid) orelse throw(badarg),
>>         catch link(Pid),
>>         Ref      = make_ref(),
>>         BRef1    = {interval, Ref},
>>         BRef2    = {system_time(WhenStarted) + Interval*1000000, Ref},
>>         Timer    = {BRef2, {daily_local_time, DOWs, Time, Pid}, MFA},
>>         ets:insert(?INTERVAL_TAB,{BRef1,BRef2,Pid}),
>>         ets:insert(?TIMER_TAB, Timer),
>>         Timeout  = timer_timeout(now()),
>>         {reply, {ok, BRef1}, [], Timeout}
>>     catch throw:Reason ->
>> 	    {reply, {error, Reason}, [], next_timeout()}
>>     end;
>>
>> handle_call({apply_interval, {Time, To, MFA}, WhenStarted}, _From, _Ts)
>>   when is_integer(Time), Time >= 0 ->
>>     Started = system_time(WhenStarted),
>>     %% To must be a pid or a registered name
>>     case get_pid(To) of
>> 	Pid when is_pid(Pid) ->
>> 	    catch link(Pid),
>> 	    NowSysTime = now(),
>> 	    Ref = make_ref(),
>> 	    BRef1 = {interval, Ref},
>> 	    Interval = Time*1000,
>> 	    BRef2 = {Started + Interval, Ref},
>> 	    Timer = {BRef2, {repeat, Interval, Pid}, MFA},
>> 	    ets:insert(?INTERVAL_TAB,{BRef1,BRef2,Pid}),
>> 	    ets:insert(?TIMER_TAB, Timer),
>> 	    Timeout = timer_timeout(NowSysTime),
>> 	    {reply, {ok, BRef1}, [], Timeout};
>> 	_ ->
>> 	    {reply, {error, badarg}, [], next_timeout()}
>>     end;
>>
>> handle_call({cancel, BRef = {_Time, Ref}, _}, _From, Ts)
>>                                            when is_reference(Ref) ->
>>     delete_ref(BRef),
>>     {reply, {ok, cancel}, Ts, next_timeout()};
>> handle_call({cancel, _BRef, _}, _From, Ts) ->
>>     {reply, {error, badarg}, Ts, next_timeout()};
>> handle_call({apply_after, _, _}, _From, Ts) ->
>>     {reply, {error, badarg}, Ts, next_timeout()};
>> handle_call({apply_at_local_time, {_, _Op}, _}, _From, Ts) ->
>>     {reply, {error, badarg}, Ts, next_timeout()};
>> handle_call({apply_interval, _, _}, _From, Ts) ->
>>     {reply, {error, badarg}, Ts, next_timeout()};
>> handle_call(_Else, _From, Ts) ->			% Catch anything else
>>     {noreply, Ts, next_timeout()}.
>>
>> handle_info(timeout, Ts) ->                     % Handle timeouts
>>     Timeout = timer_timeout(now()),
>>     {noreply, Ts, Timeout};
>> handle_info({'EXIT',  Pid, _Reason}, Ts) ->      % Oops, someone died
>>     pid_delete(Pid),
>>     {noreply, Ts, next_timeout()};
>> handle_info(_OtherMsg, Ts) ->                         % Other Msg's
>>     {noreply, Ts, next_timeout()}.
>>
>> handle_cast(_Req, Ts) ->                         % Not predicted but handled
>>     {noreply, Ts, next_timeout()}.
>>
>> terminate(_Reason, _State) ->
>>     ok.
>>
>> code_change(_OldVsn, State, _Extra) ->
>>     %% According to the man for gen server no timer can be set here.
>>     {ok, State}.
>>
>> %%
>> %% timer_timeout(NowSysTime)
>> %%
>> %% Apply and remove already timed-out timers. A timer is a tuple
>> %% {Time, BRef, Op, MFA}, where Time is in microseconds.
>> %% Returns {Timeout, Timers}, where Timeout is in milliseconds.
>> %%
>> timer_timeout(NowSysTime) ->
>>     SysTime = system_time(NowSysTime),
>>     case ets:first(?TIMER_TAB) of
>> 	'$end_of_table' ->
>> 	    infinity;
>> 	{Time, _Ref} when Time > SysTime ->
>> 	    Timeout = (Time - SysTime) div 1000,
>> 	    %% Returned timeout must fit in a small int
>> 	    min(Timeout, ?MAX_TIMEOUT);
>> 	Key ->
>> 	    case ets:lookup(?TIMER_TAB, Key) of
>> 		[{Key, timeout, MFA}] ->
>> 		    ets:delete(?TIMER_TAB,Key),
>> 		    do_apply(MFA),
>> 		    timer_timeout(NowSysTime);
>> 		[{{Time, Ref}, Repeat = {repeat, Interv, To}, MFA}] ->
>> 		    ets:delete(?TIMER_TAB,Key),
>> 		    NewTime = Time + Interv,
>> 		    %% Update the interval entry (last in table)
>> 		    ets:insert(?INTERVAL_TAB,{{interval,Ref},{NewTime,Ref},To}),
>> 		    do_apply(MFA),
>> 		    ets:insert(?TIMER_TAB, {{NewTime, Ref}, Repeat, MFA}),
>> 		    timer_timeout(NowSysTime);
>>         [{{_Time, Ref}, Repeat = {daily_local_time, DOWs, TimeOfDay, Pid}, MFA}] ->
>> 		    ets:delete(?TIMER_TAB,Key),
>>             {Date, CurTime} = calendar:now_to_local_time(add_second(NowSysTime)),
>>             DOW = calendar:day_of_the_week(Date),
>>             Interval = dow_interval(DOWs, DOW, TimeOfDay, CurTime, 0),
>>             NewTime  = system_time(NowSysTime) + Interval*1000000,
>> 		    %% Update the interval entry (last in table)
>> 		    ets:insert(?INTERVAL_TAB,{{interval,Ref},{NewTime,Ref},Pid}),
>> 		    do_apply(MFA),
>> 		    ets:insert(?TIMER_TAB, {{NewTime, Ref}, Repeat, MFA}),
>> 		    timer_timeout(NowSysTime)
>> 	    end
>>     end.
>>
>> %%
>> %% delete_ref
>> %%
>>
>> delete_ref(BRef = {interval, _}) ->
>>     case ets:lookup(?INTERVAL_TAB, BRef) of
>> 	[{_, BRef2, _Pid}] ->
>> 	    ets:delete(?INTERVAL_TAB, BRef),
>> 	    ets:delete(?TIMER_TAB, BRef2);
>> 	_ -> % TimerReference does not exist, do nothing
>> 	    ok
>>     end;
>> delete_ref(BRef) ->
>>     ets:delete(?TIMER_TAB,BRef).
>>
>> %%
>> %% pid_delete
>> %%
>>
>> pid_delete(Pid) ->
>>     IntervalTimerList =
>> 	ets:select(?INTERVAL_TAB,
>> 		   [{{'_', '_','$1'},
>> 		     [{'==','$1',Pid}],
>> 		     ['$_']}]),
>>     lists:foreach(fun({IntKey, TimerKey, _ }) ->
>> 			  ets:delete(?INTERVAL_TAB,IntKey),
>> 			  ets:delete(?TIMER_TAB,TimerKey)
>> 		  end, IntervalTimerList).
>>
>> %% Calculate time to the next timeout. Returned timeout must fit in a
>> %% small int.
>>
>> next_timeout() ->
>>     case ets:first(?TIMER_TAB) of
>> 	'$end_of_table' ->
>> 	    infinity;
>> 	{Time, _ } ->
>> 	    min(positive((Time - system_time()) div 1000), ?MAX_TIMEOUT)
>>     end.
>>
>> %% Help functions
>> do_apply({M,F,A}) ->
>>     case {M, F, A} of
>> 	{?MODULE, send, A} ->
>> 	    %% If send op. send directly, (faster than spawn)
>> 	    catch send(A);
>> 	{erlang, exit, [Name, Reason]} ->
>> 	    catch exit(get_pid(Name), Reason);
>> 	_ ->
>> 	    %% else spawn process with the operation
>> 	    catch spawn(M,F,A)
>>     end.
>>
>> max(X, Y) when X > Y ->
>>     X;
>> max(_X, Y) ->
>>     Y.
>>
>> min(X, Y) when X < Y ->
>>     X;
>> min(_X, Y) ->
>>     Y.
>>
>> positive(X) ->
>>     max(X, 0).
>>
>> to_dow(mon) -> 1;
>> to_dow(tue) -> 2;
>> to_dow(wed) -> 3;
>> to_dow(thu) -> 4;
>> to_dow(fri) -> 5;
>> to_dow(sat) -> 6;
>> to_dow(sun) -> 7;
>> to_dow(I) when is_integer(I), I >= 1, I =< 7 -> I;
>> to_dow(_)   -> throw(badarg).
>>
>> seconds_diff({H2,M2,S2}, {H1,M1,S1}) ->
>>     (H2-H1)*3600 + (M2-M1)*60 + (S2-S1).
>>
>> add_second({M,S,U}) when S < 1000000 ->
>>     {M,S+1,U};
>> add_second({M,_,U}) ->
>>     {M+1,0,U}.
>>
>> dow_interval(DOWs, Dow, Time, NowTime, 0) when element(Dow, DOWs) =:= 1 ->
>>     case seconds_diff(Time, NowTime) of
>>     TodayInterval when TodayInterval >= 0 ->
>>         TodayInterval;
>>     _ ->
>>         % Current time passed target time for today.
>>         % Find interval from NowTime to future Time.
>>         dow_interval(DOWs, Dow, Time, NowTime, 1)
>>     end;
>> dow_interval(DOWs, Dow, Time, NowTime, _) ->
>>     % Current time is in another DayOfWeek.
>>     % Find interval from NowTime to future Time.
>>     NextDays = get_days(DOWs, (Dow rem 7) + 1, 0),
>>     seconds_diff({24,0,0}, NowTime)     % Seconds from now until end-of-day
>>     + NextDays*86400                    % Seconds in days until given day of week
>>     + seconds_diff(Time, {0,0,0}).      % Seconds from beginning of day to Time
>>
>> get_days(DOWs, Dow, N) when element(Dow, DOWs) =:= 1 ->
>>     N;
>> get_days(DOWs, Dow, N) when N < 8 ->
>>     get_days(DOWs, (Dow rem 7) + 1, N+1);
>> get_days(_, _, _) ->
>>     throw(badarg).
>>
>> %%
>> %%  system_time() -> time in microseconds
>> %%
>> system_time() ->
>>     Now = erlang:now(),
>>     system_time(Now).
>> system_time(Now) ->
>>     {M,S,U} = Now,
>>     1000000*(M*1000000 + S) + U.
>>
>> send([Pid, Msg]) ->
>>     Pid ! Msg.
>>
>> get_pid(Name) when is_pid(Name) ->
>>     Name;
>> get_pid(undefined) ->
>>     undefined;
>> get_pid(Name) when is_atom(Name) ->
>>     get_pid(whereis(Name));
>> get_pid(_) ->
>>     undefined.
>>
>> %%
>> %% get_status() ->
>> %%    {{TimerTabName,TotalNumTimers},{IntervalTabName,NumIntervalTimers}}
>> %%
>> %% This function is for test purposes only; it is used by the test suite.
>> %% There is a small possibility that there is a mismatch of one entry
>> %% between the 2 tables if this call is made when the timer server is
>> %% in the middle of a transaction
>>
>> get_status() ->
>>     Info1 = ets:info(?TIMER_TAB),
>>     {value,{size,TotalNumTimers}} = lists:keysearch(size, 1, Info1),
>>     Info2 = ets:info(?INTERVAL_TAB),
>>     {value,{size,NumIntervalTimers}} = lists:keysearch(size, 1, Info2),
>>     {{?TIMER_TAB,TotalNumTimers},{?INTERVAL_TAB,NumIntervalTimers}}.
> 
>> _______________________________________________
>> erlang-questions mailing list
>> 
>> http://www.erlang.org/mailman/listinfo/erlang-questions
> 




More information about the erlang-questions mailing list