[erlang-questions] extended timer module to handle absolute time-of-day timers
Michael McDaniel
erlangy@REDACTED
Mon Mar 2 23:18:17 CET 2009
Hi, Serge.
I am not having any known problems with timed_supervisor.
Still, I would like to upgrade when available.
thanks,
~Michael
On Tue, Jan 13, 2009 at 10:04:01PM -0500, Serge Aleynikov wrote:
> 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 <saleyn@REDACTED>
> >> %% 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
> >> erlang-questions@REDACTED
> >> http://www.erlang.org/mailman/listinfo/erlang-questions
> >
>
> _______________________________________________
> erlang-questions mailing list
> erlang-questions@REDACTED
> http://www.erlang.org/mailman/listinfo/erlang-questions
--
Michael McDaniel
Portland, Oregon, USA
http://trip.autosys.us
http://mmcdaniel.com/erlview
More information about the erlang-questions
mailing list