From 5a9cdd3cc89507d4d74f8bded56ce5e037b3b56e Mon Sep 17 00:00:00 2001 From: Trygve Laugstøl Date: Fri, 23 Feb 2024 07:08:18 +0100 Subject: wip --- learn-you-some-erlang/release/erlcount-1.0.config | 20 +++ learn-you-some-erlang/release/erlcount-1.0.rel | 7 + .../release/erlcount-1.0/Emakefile | 4 + .../release/erlcount-1.0/ebin/erlcount.app | 14 ++ .../release/erlcount-1.0/src/erlcount.erl | 9 + .../release/erlcount-1.0/src/erlcount_counter.erl | 35 ++++ .../release/erlcount-1.0/src/erlcount_dispatch.erl | 86 +++++++++ .../release/erlcount-1.0/src/erlcount_lib.erl | 55 ++++++ .../release/erlcount-1.0/src/erlcount_sup.erl | 17 ++ .../release/erlcount-1.0/test/erlcount_tests.erl | 35 ++++ learn-you-some-erlang/release/erlcount-sm.config | 17 ++ learn-you-some-erlang/release/ppool-1.0/Emakefile | 2 + .../release/ppool-1.0/ebin/ppool.app | 8 + .../release/ppool-1.0/src/ppool.erl | 26 +++ .../release/ppool-1.0/src/ppool_serv.erl | 113 ++++++++++++ .../release/ppool-1.0/src/ppool_sup.erl | 17 ++ .../release/ppool-1.0/src/ppool_supersup.erl | 22 +++ .../release/ppool-1.0/src/ppool_worker_sup.erl | 15 ++ .../release/ppool-1.0/test/ppool_nagger.erl | 50 ++++++ .../release/ppool-1.0/test/ppool_tests.erl | 200 +++++++++++++++++++++ .../rel/.this-file-intentionally-left-blank | 0 21 files changed, 752 insertions(+) create mode 100644 learn-you-some-erlang/release/erlcount-1.0.config create mode 100644 learn-you-some-erlang/release/erlcount-1.0.rel create mode 100644 learn-you-some-erlang/release/erlcount-1.0/Emakefile create mode 100644 learn-you-some-erlang/release/erlcount-1.0/ebin/erlcount.app create mode 100644 learn-you-some-erlang/release/erlcount-1.0/src/erlcount.erl create mode 100644 learn-you-some-erlang/release/erlcount-1.0/src/erlcount_counter.erl create mode 100644 learn-you-some-erlang/release/erlcount-1.0/src/erlcount_dispatch.erl create mode 100644 learn-you-some-erlang/release/erlcount-1.0/src/erlcount_lib.erl create mode 100644 learn-you-some-erlang/release/erlcount-1.0/src/erlcount_sup.erl create mode 100644 learn-you-some-erlang/release/erlcount-1.0/test/erlcount_tests.erl create mode 100644 learn-you-some-erlang/release/erlcount-sm.config create mode 100644 learn-you-some-erlang/release/ppool-1.0/Emakefile create mode 100644 learn-you-some-erlang/release/ppool-1.0/ebin/ppool.app create mode 100644 learn-you-some-erlang/release/ppool-1.0/src/ppool.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/src/ppool_serv.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/src/ppool_sup.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/src/ppool_supersup.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/src/ppool_worker_sup.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl create mode 100644 learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl create mode 100644 learn-you-some-erlang/release/rel/.this-file-intentionally-left-blank (limited to 'learn-you-some-erlang/release') diff --git a/learn-you-some-erlang/release/erlcount-1.0.config b/learn-you-some-erlang/release/erlcount-1.0.config new file mode 100644 index 0000000..235ab23 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0.config @@ -0,0 +1,20 @@ +{sys, [ + {lib_dirs, ["/home/ferd/code/learn-you-some-erlang/release/"]}, + {erts, [{vsn, "5.8.4"}]}, + {rel, "erlcount", "1.0.0", + [kernel, + stdlib, + {ppool, permanent}, + {erlcount, transient} + ]}, + {boot_rel, "erlcount"}, + {relocatable, true}, + {profile, embedded}, + {app, ppool, [{vsn, "1.0.0"}, + {app_file, all}, + {debug_info, keep}]}, + {app, erlcount, [{vsn, "1.0.0"}, + {incl_cond, include}, + {app_file, strip}, + {debug_info, strip}]} +]}. diff --git a/learn-you-some-erlang/release/erlcount-1.0.rel b/learn-you-some-erlang/release/erlcount-1.0.rel new file mode 100644 index 0000000..aa2ce44 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0.rel @@ -0,0 +1,7 @@ +{release, + {"erlcount", "1.0.0"}, + {erts, "5.8.4"}, + [{kernel, "2.14.4"}, + {stdlib, "1.17.4"}, + {ppool, "1.0.0", permanent}, + {erlcount, "1.0.0", transient}]}. diff --git a/learn-you-some-erlang/release/erlcount-1.0/Emakefile b/learn-you-some-erlang/release/erlcount-1.0/Emakefile new file mode 100644 index 0000000..76e98fc --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/Emakefile @@ -0,0 +1,4 @@ +{"src/*", [debug_info, {i,"include/"}, {outdir, "ebin/"}]}. +%% The TESTDIR macro assumes the file is running from the 'erlcount-1.0' +%% directory, sitting within 'learn-you-some-erlang/'. +{"test/*", [debug_info, {i,"include/"}, {outdir, "ebin/"}, {d, 'TESTDIR', ".."}]}. diff --git a/learn-you-some-erlang/release/erlcount-1.0/ebin/erlcount.app b/learn-you-some-erlang/release/erlcount-1.0/ebin/erlcount.app new file mode 100644 index 0000000..22f0f0a --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/ebin/erlcount.app @@ -0,0 +1,14 @@ +{application, erlcount, + [{vsn, "1.0.0"}, + {description, "Run regular expressions on Erlang source files"}, + {modules, [erlcount, erlcount_sup, erlcount_lib, + erlcount_dispatch, erlcount_counter]}, + {applications, [stdlib, kernel, ppool]}, + {registered, [erlcount]}, + {mod, {erlcount, []}}, + {env, + [{directory, "."}, + {regex, ["if\\s.+->", "case\\s.+\\sof"]}, + {max_files, 10}]} + ]}. + diff --git a/learn-you-some-erlang/release/erlcount-1.0/src/erlcount.erl b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount.erl new file mode 100644 index 0000000..16a9f23 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount.erl @@ -0,0 +1,9 @@ +-module(erlcount). +-behaviour(application). +-export([start/2, stop/1]). + +start(normal, _Args) -> + erlcount_sup:start_link(). + +stop(_State) -> + ok. diff --git a/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_counter.erl b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_counter.erl new file mode 100644 index 0000000..c42fd4d --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_counter.erl @@ -0,0 +1,35 @@ +-module(erlcount_counter). +-behaviour(gen_server). +-export([start_link/4]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-record(state, {dispatcher, ref, file, re}). + +start_link(DispatcherPid, Ref, FileName, Regex) -> + gen_server:start_link(?MODULE, [DispatcherPid, Ref, FileName, Regex], []). + +init([DispatcherPid, Ref, FileName, Regex]) -> + self() ! start, + {ok, #state{dispatcher=DispatcherPid, + ref = Ref, + file = FileName, + re = Regex}}. + +handle_call(_Msg, _From, State) -> + {noreply, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(start, S = #state{re=Re, ref=Ref}) -> + {ok, Bin} = file:read_file(S#state.file), + Count = erlcount_lib:regex_count(Re, Bin), + erlcount_dispatch:complete(S#state.dispatcher, Re, Ref, Count), + {stop, normal, S}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_dispatch.erl b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_dispatch.erl new file mode 100644 index 0000000..c125da3 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_dispatch.erl @@ -0,0 +1,86 @@ +-module(erlcount_dispatch). +-behaviour(gen_fsm). +-export([start_link/0, complete/4]). +-export([init/1, dispatching/2, listening/2, handle_event/3, + handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). + +-define(POOL, erlcount). +-record(data, {regex=[], refs=[]}). + +%%% PUBLIC API +start_link() -> + gen_fsm:start_link(?MODULE, [], []). + +complete(Pid, Regex, Ref, Count) -> + gen_fsm:send_all_state_event(Pid, {complete, Regex, Ref, Count}). + +%%% GEN_FSM +%% Two states: dispatching and listening +init([]) -> + %% Move the get_env stuff to the supervisor's init. + {ok, Re} = application:get_env(regex), + {ok, Dir} = application:get_env(directory), + {ok, MaxFiles} = application:get_env(max_files), + ppool:start_pool(?POOL, MaxFiles, {erlcount_counter, start_link, []}), + case lists:all(fun valid_regex/1, Re) of + true -> + %% creates a regex entry of the form [{Re, Count}] + self() ! {start, Dir}, + {ok, dispatching, #data{regex=[{R,0} || R <- Re]}}; + false -> + {stop, invalid_regex} + end. + +dispatching({continue, File, Continuation}, Data = #data{regex=Re, refs=Refs}) -> + F = fun({Regex,_Count}, NewRefs) -> + Ref = make_ref(), + ppool:async_queue(?POOL, [self(), Ref, File, Regex]), + [Ref|NewRefs] + end, + NewRefs = lists:foldl(F, Refs, Re), + gen_fsm:send_event(self(), Continuation()), + {next_state, dispatching, Data#data{refs = NewRefs}}; +dispatching(done, Data) -> + %% This is a special case. We can not assume that all messages have NOT + %% been received by the time we hit 'done'. As such, we directly move to + %% listening/2 without waiting for an external event. + listening(done, Data). + +listening(done, #data{regex=Re, refs=[]}) -> % all received! + [io:format("Regex ~s has ~p results~n", [R,C]) || {R, C} <- Re], + {stop, normal, done}; +listening(done, Data) -> % entries still missing + {next_state, listening, Data}. + +handle_event({complete, Regex, Ref, Count}, State, Data = #data{regex=Re, refs=Refs}) -> + {Regex, OldCount} = lists:keyfind(Regex, 1, Re), + NewRe = lists:keyreplace(Regex, 1, Re, {Regex, OldCount+Count}), + NewData = Data#data{regex=NewRe, refs=Refs--[Ref]}, + case State of + dispatching -> + {next_state, dispatching, NewData}; + listening -> + listening(done, NewData) + end. + +handle_sync_event(Event, _From, State, Data) -> + io:format("Unexpected event: ~p~n", [Event]), + {next_state, State, Data}. + +handle_info({start, Dir}, State, Data) -> + gen_fsm:send_event(self(), erlcount_lib:find_erl(Dir)), + {next_state, State, Data}. + +terminate(_Reason, _State, _Data) -> + init:stop(). + +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%%% PRIVATE +valid_regex(Re) -> + try re:run("", Re) of + _ -> true + catch + error:badarg -> false + end. diff --git a/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_lib.erl b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_lib.erl new file mode 100644 index 0000000..70c062f --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_lib.erl @@ -0,0 +1,55 @@ +-module(erlcount_lib). +-export([find_erl/1, regex_count/2]). +-include_lib("kernel/include/file.hrl"). + +%% Finds all files ending in .erl +find_erl(Directory) -> + find_erl(Directory, queue:new()). + +regex_count(Re, Str) -> + case re:run(Str, Re, [global]) of + nomatch -> 0; + {match, List} -> length(List) + end. + +%%% Private +%% Dispatches based on file type +find_erl(Name, Queue) -> + {ok, F = #file_info{}} = file:read_file_info(Name), + case F#file_info.type of + directory -> handle_directory(Name, Queue); + regular -> handle_regular_file(Name, Queue); + _Other -> dequeue_and_run(Queue) + end. + +%% Opens directories and enqueues files in there +handle_directory(Dir, Queue) -> + case file:list_dir(Dir) of + {ok, []} -> + dequeue_and_run(Queue); + {ok, Files} -> + dequeue_and_run(enqueue_many(Dir, Files, Queue)) + end. + +%% Checks if the file finishes in .erl +handle_regular_file(Name, Queue) -> + case filename:extension(Name) of + ".erl" -> + {continue, Name, fun() -> dequeue_and_run(Queue) end}; + _NonErl -> + dequeue_and_run(Queue) + end. + +%% Pops an item from the queue and runs it. +dequeue_and_run(Queue) -> + case queue:out(Queue) of + {empty, _} -> done; + {{value, File}, NewQueue} -> find_erl(File, NewQueue) + end. + +%% Adds a bunch of items to the queue. +enqueue_many(Path, Files, Queue) -> + F = fun(File, Q) -> queue:in(filename:join(Path,File), Q) end, + lists:foldl(F, Queue, Files). + + diff --git a/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_sup.erl b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_sup.erl new file mode 100644 index 0000000..b8633a3 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/src/erlcount_sup.erl @@ -0,0 +1,17 @@ +-module(erlcount_sup). +-behaviour(supervisor). +-export([start_link/0, init/1]). + +start_link() -> + supervisor:start_link(?MODULE, []). + +init([]) -> + MaxRestart = 5, + MaxTime = 100, + {ok, {{one_for_one, MaxRestart, MaxTime}, + [{dispatch, + {erlcount_dispatch, start_link, []}, + transient, + 60000, + worker, + [erlcount_dispatch]}]}}. diff --git a/learn-you-some-erlang/release/erlcount-1.0/test/erlcount_tests.erl b/learn-you-some-erlang/release/erlcount-1.0/test/erlcount_tests.erl new file mode 100644 index 0000000..7459a39 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-1.0/test/erlcount_tests.erl @@ -0,0 +1,35 @@ +-module(erlcount_tests). +-include_lib("eunit/include/eunit.hrl"). +-ifndef(TESTDIR). +%% Assumes we're running from the app's directory. We want to target the +%% 'learn-you-some-erlang' directory. +-define(TESTDIR, ".."). +-endif. + +%% NOTE: +%% Because we do not want the tests to be bound to a specific snapshot in time +%% of our app, we will instead compare it to an oracle built with unix +%% commands. Users running windows sadly won't be able to run these tests. + +%% We'll be forcing the design to be continuation-based when it comes to +%% reading files. This will require some explaining to the user, but will +%% allow to show how we can read files and schedule them at the same time, +%% but without breaking functional principles of referential transparency +%% and while allowing specialised functions to be written in a testable manner. +find_erl_test_() -> + ?_assertEqual(lists:sort(string:tokens(os:cmd("find "++?TESTDIR++" -name *.erl"), "\n")), + lists:sort(build_list(erlcount_lib:find_erl(?TESTDIR)))). + +build_list(Term) -> build_list(Term, []). + +build_list(done, List) -> List; +build_list({continue, Entry, Fun}, List) -> + build_list(Fun(), [Entry|List]). + +regex_count_test_() -> + [?_assertEqual(5, erlcount_lib:regex_count("a", "a a a a a")), + ?_assertEqual(0, erlcount_lib:regex_count("o", "a a a a a")), + ?_assertEqual(2, erlcount_lib:regex_count("a.*", "a a a\na a a")), + ?_assertEqual(3, erlcount_lib:regex_count("if", "myiffun() ->\n if 1 < \" if \" -> ok;\n true -> other\n end.\n")), + ?_assertEqual(1, erlcount_lib:regex_count("if[\\s]{1}(?:.+)->", "myiffun() ->\n if 1 < \" if \" -> ok;\n true -> other\n end.\n")), + ?_assertEqual(2, erlcount_lib:regex_count("if[\\s]{1}(?:.+)->", "myiffun() ->\n if 1 < \" if \" -> ok;\n true -> other\n end,\n if true -> ok end.\n"))]. diff --git a/learn-you-some-erlang/release/erlcount-sm.config b/learn-you-some-erlang/release/erlcount-sm.config new file mode 100644 index 0000000..6e22bf1 --- /dev/null +++ b/learn-you-some-erlang/release/erlcount-sm.config @@ -0,0 +1,17 @@ +{sys, [ + {lib_dirs, ["/home/ferd/code/learn-you-some-erlang/release/"]}, + {erts, [{mod_cond, derived}, + {app_file, strip}]}, + {rel, "erlcount", "1.0.0", [kernel, stdlib, ppool, erlcount]}, + {boot_rel, "erlcount"}, + {relocatable, true}, + {profile, embedded}, + {app_file, strip}, + {debug_info, strip}, + {incl_cond, exclude}, + {excl_app_filters, ["_tests.beam"]}, + {app, stdlib, [{incl_cond, include}]}, + {app, kernel, [{incl_cond, include}]}, + {app, ppool, [{vsn, "1.0.0"}, {incl_cond, include}]}, + {app, erlcount, [{vsn, "1.0.0"}, {incl_cond, include}]} +]}. diff --git a/learn-you-some-erlang/release/ppool-1.0/Emakefile b/learn-you-some-erlang/release/ppool-1.0/Emakefile new file mode 100644 index 0000000..8e1f951 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/Emakefile @@ -0,0 +1,2 @@ +{"src/*", [debug_info, {i,"include/"}, {outdir, "ebin/"}]}. +{"test/*", [debug_info, {i,"include/"}, {outdir, "ebin/"}]}. diff --git a/learn-you-some-erlang/release/ppool-1.0/ebin/ppool.app b/learn-you-some-erlang/release/ppool-1.0/ebin/ppool.app new file mode 100644 index 0000000..f806b7c --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/ebin/ppool.app @@ -0,0 +1,8 @@ +{application, ppool, + [{vsn, "1.0.0"}, + {description, "Run and enqueue different concurrent tasks"}, + {modules, [ppool, ppool_serv, ppool_sup, ppool_supersup, ppool_worker_sup]}, + {applications, [stdlib, kernel]}, + {registered, [ppool]}, + {mod, {ppool, []}} + ]}. diff --git a/learn-you-some-erlang/release/ppool-1.0/src/ppool.erl b/learn-you-some-erlang/release/ppool-1.0/src/ppool.erl new file mode 100644 index 0000000..5723f98 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/src/ppool.erl @@ -0,0 +1,26 @@ +%%% API module for the pool +-module(ppool). +-behaviour(application). +-export([start/2, stop/1, start_pool/3, + run/2, sync_queue/2, async_queue/2, stop_pool/1]). + +start(normal, _Args) -> + ppool_supersup:start_link(). + +stop(_State) -> + ok. + +start_pool(Name, Limit, {M,F,A}) -> + ppool_supersup:start_pool(Name, Limit, {M,F,A}). + +stop_pool(Name) -> + ppool_supersup:stop_pool(Name). + +run(Name, Args) -> + ppool_serv:run(Name, Args). + +async_queue(Name, Args) -> + ppool_serv:async_queue(Name, Args). + +sync_queue(Name, Args) -> + ppool_serv:sync_queue(Name, Args). diff --git a/learn-you-some-erlang/release/ppool-1.0/src/ppool_serv.erl b/learn-you-some-erlang/release/ppool-1.0/src/ppool_serv.erl new file mode 100644 index 0000000..bfb9b93 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/src/ppool_serv.erl @@ -0,0 +1,113 @@ +-module(ppool_serv). +-behaviour(gen_server). +-export([start/4, start_link/4, run/2, sync_queue/2, async_queue/2, stop/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + code_change/3, terminate/2]). + +%% The friendly supervisor is started dynamically! +-define(SPEC(MFA), + {worker_sup, + {ppool_worker_sup, start_link, [MFA]}, + temporary, + 10000, + supervisor, + [ppool_worker_sup]}). + +-record(state, {limit=0, + sup, + refs, + queue=queue:new()}). + +start(Name, Limit, Sup, MFA) when is_atom(Name), is_integer(Limit) -> + gen_server:start({local, Name}, ?MODULE, {Limit, MFA, Sup}, []). + +start_link(Name, Limit, Sup, MFA) when is_atom(Name), is_integer(Limit) -> + gen_server:start_link({local, Name}, ?MODULE, {Limit, MFA, Sup}, []). + +run(Name, Args) -> + gen_server:call(Name, {run, Args}). + +sync_queue(Name, Args) -> + gen_server:call(Name, {sync, Args}, infinity). + +async_queue(Name, Args) -> + gen_server:cast(Name, {async, Args}). + +stop(Name) -> + gen_server:call(Name, stop). + +%% Gen server +init({Limit, MFA, Sup}) -> + %% We need to find the Pid of the worker supervisor from here, + %% but alas, this would be calling the supervisor while it waits for us! + self() ! {start_worker_supervisor, Sup, MFA}, + {ok, #state{limit=Limit, refs=gb_sets:empty()}}. + +handle_call({run, Args}, _From, S = #state{limit=N, sup=Sup, refs=R}) when N > 0 -> + {ok, Pid} = supervisor:start_child(Sup, Args), + Ref = erlang:monitor(process, Pid), + {reply, {ok,Pid}, S#state{limit=N-1, refs=gb_sets:add(Ref,R)}}; +handle_call({run, _Args}, _From, S=#state{limit=N}) when N =< 0 -> + {reply, noalloc, S}; + +handle_call({sync, Args}, _From, S = #state{limit=N, sup=Sup, refs=R}) when N > 0 -> + {ok, Pid} = supervisor:start_child(Sup, Args), + Ref = erlang:monitor(process, Pid), + {reply, {ok,Pid}, S#state{limit=N-1, refs=gb_sets:add(Ref,R)}}; +handle_call({sync, Args}, From, S = #state{queue=Q}) -> + {noreply, S#state{queue=queue:in({From, Args}, Q)}}; + +handle_call(stop, _From, State) -> + {stop, normal, ok, State}; +handle_call(_Msg, _From, State) -> + {noreply, State}. + + +handle_cast({async, Args}, S=#state{limit=N, sup=Sup, refs=R}) when N > 0 -> + {ok, Pid} = supervisor:start_child(Sup, Args), + Ref = erlang:monitor(process, Pid), + {noreply, S#state{limit=N-1, refs=gb_sets:add(Ref,R)}}; +handle_cast({async, Args}, S=#state{limit=N, queue=Q}) when N =< 0 -> + {noreply, S#state{queue=queue:in(Args,Q)}}; + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info({'DOWN', Ref, process, _Pid, _}, S = #state{refs=Refs}) -> +%% io:format("received down msg~n"), + case gb_sets:is_element(Ref, Refs) of + true -> + handle_down_worker(Ref, S); + false -> %% Not our responsibility + {noreply, S} + end; +handle_info({start_worker_supervisor, Sup, MFA}, S = #state{}) -> + {ok, Pid} = supervisor:start_child(Sup, ?SPEC(MFA)), + link(Pid), + {noreply, S#state{sup=Pid}}; +handle_info(Msg, State) -> + io:format("Unknown msg: ~p~n", [Msg]), + {noreply, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. + +handle_down_worker(Ref, S = #state{limit=L, sup=Sup, refs=Refs}) -> + case queue:out(S#state.queue) of + {{value, {From, Args}}, Q} -> + {ok, Pid} = supervisor:start_child(Sup, Args), + NewRef = erlang:monitor(process, Pid), + NewRefs = gb_sets:insert(NewRef, gb_sets:delete(Ref,Refs)), + gen_server:reply(From, {ok, Pid}), + {noreply, S#state{refs=NewRefs, queue=Q}}; + {{value, Args}, Q} -> + {ok, Pid} = supervisor:start_child(Sup, Args), + NewRef = erlang:monitor(process, Pid), + NewRefs = gb_sets:insert(NewRef, gb_sets:delete(Ref,Refs)), + {noreply, S#state{refs=NewRefs, queue=Q}}; + {empty, _} -> + {noreply, S#state{limit=L+1, refs=gb_sets:delete(Ref,Refs)}} + end. diff --git a/learn-you-some-erlang/release/ppool-1.0/src/ppool_sup.erl b/learn-you-some-erlang/release/ppool-1.0/src/ppool_sup.erl new file mode 100644 index 0000000..71ec31d --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/src/ppool_sup.erl @@ -0,0 +1,17 @@ +-module(ppool_sup). +-export([start_link/3, init/1]). +-behaviour(supervisor). + +start_link(Name, Limit, MFA) -> + supervisor:start_link(?MODULE, {Name, Limit, MFA}). + +init({Name, Limit, MFA}) -> + MaxRestart = 1, + MaxTime = 3000, + {ok, {{one_for_all, MaxRestart, MaxTime}, + [{serv, + {ppool_serv, start_link, [Name, Limit, self(), MFA]}, + permanent, + 5000, + worker, + [ppool_serv]}]}}. diff --git a/learn-you-some-erlang/release/ppool-1.0/src/ppool_supersup.erl b/learn-you-some-erlang/release/ppool-1.0/src/ppool_supersup.erl new file mode 100644 index 0000000..06fa0af --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/src/ppool_supersup.erl @@ -0,0 +1,22 @@ +-module(ppool_supersup). +-behaviour(supervisor). +-export([start_link/0, start_pool/3, stop_pool/1]). +-export([init/1]). + +start_link() -> + supervisor:start_link({local, ppool}, ?MODULE, []). + +start_pool(Name, Limit, MFA) -> + ChildSpec = {Name, + {ppool_sup, start_link, [Name, Limit, MFA]}, + permanent, 10500, supervisor, [ppool_sup]}, + supervisor:start_child(ppool, ChildSpec). + +stop_pool(Name) -> + supervisor:terminate_child(ppool, Name), + supervisor:delete_child(ppool, Name). + +init([]) -> + MaxRestart = 6, + MaxTime = 3000, + {ok, {{one_for_one, MaxRestart, MaxTime}, []}}. diff --git a/learn-you-some-erlang/release/ppool-1.0/src/ppool_worker_sup.erl b/learn-you-some-erlang/release/ppool-1.0/src/ppool_worker_sup.erl new file mode 100644 index 0000000..2467c47 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/src/ppool_worker_sup.erl @@ -0,0 +1,15 @@ +-module(ppool_worker_sup). +-export([start_link/1, init/1]). +-behaviour(supervisor). + +start_link(MFA = {_,_,_}) -> + supervisor:start_link(?MODULE, MFA). + +init({M,F,A}) -> + MaxRestart = 5, + MaxTime = 3600, + {ok, {{simple_one_for_one, MaxRestart, MaxTime}, + [{ppool_worker, + {M,F,A}, + temporary, 5000, worker, [M]}]}}. + diff --git a/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl b/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl new file mode 100644 index 0000000..903f821 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl @@ -0,0 +1,50 @@ +%% demo module, a nagger for tasks, +%% because the previous one wasn't good enough +%% +%% Can take: +%% - a time delay for which to nag, +%% - an adress to say where the messages should be sent +%% - a message to send in the mailbox telling you what to nag, +%% with an id to be able to call: -> +%% - a command to say the task is done +-module(ppool_nagger). +-behaviour(gen_server). +-export([start_link/4, stop/1]). +-export([init/1, handle_call/3, handle_cast/2, + handle_info/2, code_change/3, terminate/2]). + +start_link(Task, Delay, Max, SendTo) -> + gen_server:start_link(?MODULE, {Task, Delay, Max, SendTo} , []). + +stop(Pid) -> + gen_server:call(Pid, stop). + +init({Task, Delay, Max, SendTo}) -> + process_flag(trap_exit, true), % for tests & terminate too + {ok, {Task, Delay, Max, SendTo}, Delay}. + +%%% OTP Callbacks +handle_call(stop, _From, State) -> + {stop, normal, ok, State}; +handle_call(_Msg, _From, State) -> + {noreply, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(timeout, {Task, Delay, Max, SendTo}) -> + SendTo ! {self(), Task}, + if Max =:= infinity -> + {noreply, {Task, Delay, Max, SendTo}, Delay}; + Max =< 1 -> + {stop, normal, {Task, Delay, 0, SendTo}}; + Max > 1 -> + {noreply, {Task, Delay, Max-1, SendTo}, Delay} + end; +handle_info(_Msg, State) -> + {noreply, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +terminate(_Reason, _State) -> ok. diff --git a/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl b/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl new file mode 100644 index 0000000..8f0dfe2 --- /dev/null +++ b/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl @@ -0,0 +1,200 @@ +-module(ppool_tests). +-include_lib("eunit/include/eunit.hrl"). +-export([test_mfa/1, wait_mfa/1]). + +%%% All Test Fixtures +start_test_() -> + {"It should be possible to start a pool server and give it a name", + {setup, + fun find_unique_name/0, + fun(Name) -> + [start_and_test_name(Name)] + end}}. + +mfa_test_() -> + {"A pool process can be allocated which will be ordered " + "to run an MFA call determined at start time, with arguments " + "provided at call time", + {setup, + fun start_ppool/0, + fun kill_ppool/1, + fun(Name) -> + [pool_run_mfa(Name)] + end} + }. + +alloc_test_() -> + {"A pool process can be allocated which will be ordered " + "to run a worker, only if there are enough which " + "haven't been ordered to run yet.", + {setup, + fun start_ppool/0, + fun kill_ppool/1, + fun(Name) -> + [pool_run_alloc(Name), + pool_run_noalloc(Name)] + end} + }. + +realloc_test_() -> + {"When an allocated process dies, " + "A new one can be allocated to replace it.", + {setup, + fun start_ppool/0, + fun kill_ppool/1, + fun(Name) -> + [pool_run_realloc(Name)] + end} + }. + +queue_test_() -> + {"The queue function can be used to run the function as soon as possible. " + "If no space is available, the worker call is added to the queue.", + {foreach, + fun start_ppool/0, + fun kill_ppool/1, + [fun(Name) -> test_async_queue(Name) end, + fun(Name) -> test_sync_queue(Name) end]} + }. + +supervision_test_() -> + {"The ppool will never restart a dead child, but all children (OTP " + "compliant) will be shut down when closing the pool, even if they " + "are trapping exits", + {setup, + fun find_unique_name/0, + fun test_supervision/1}}. + +auth_test_() -> + {"The ppool should only dequeue tasks after receiving a down signal " + "from a worker and nobody else", + {setup, + fun start_ppool/0, + fun kill_ppool/1, + fun test_auth_dealloc/1}}. + +%%% Setups/teardowns +find_unique_name() -> + application:start(ppool), + Name = list_to_atom(lists:flatten(io_lib:format("~p",[now()]))), + ?assertEqual(undefined, whereis(Name)), + Name. + +start_ppool() -> + Name = find_unique_name(), + ppool:start_pool(Name, 2, {ppool_nagger, start_link, []}), + Name. + +kill_ppool(Name) -> + ppool:stop_pool(Name). + +%%% Actual tests +start_and_test_name(Name) -> + ppool:start_pool(Name, 1, {ppool_nagger, start_link, []}), + A = whereis(Name), + ppool:stop_pool(Name), + timer:sleep(100), + B = whereis(Name), + [?_assert(undefined =/= A), + ?_assertEqual(undefined, B)]. + +pool_run_mfa(Name) -> + ppool:run(Name, [i_am_running, 1, 1, self()]), + X = receive + {_Pid, i_am_running} -> ok + after 3000 -> + timeout + end, + ?_assertEqual(ok, X). + +pool_run_alloc(Name) -> + {ok, Pid} = ppool:run(Name, [i_am_running, 1, 1, self()]), + X = receive + {Pid, i_am_running} -> ok + after 3000 -> + timeout + end, + [?_assert(is_pid(Pid)), + ?_assertEqual(ok, X)]. + +pool_run_noalloc(Name) -> + %% Init function should have set the limit to 2 + ppool:run(Name, [i_am_running, 300, 1, self()]), + ppool:run(Name, [i_am_running, 300, 1, self()]), + X = ppool:run(Name, [i_am_running, 1, 1, self()]), + ?_assertEqual(noalloc, X). + +pool_run_realloc(Name) -> + %% Init function should have set the limit to 2 + {ok, A} = ppool:run(Name, [i_am_running, 500, 1, self()]), + timer:sleep(100), + {ok, B} = ppool:run(Name, [i_am_running, 500, 1, self()]), + timer:sleep(600), + {ok, Pid} = ppool:run(Name, [i_am_running, 1, 1, self()]), + timer:sleep(100), + L = flush(), + [?_assert(is_pid(Pid)), + ?_assertEqual([{A,i_am_running}, {B,i_am_running}, {Pid,i_am_running}], + L)]. + +test_async_queue(Name) -> + %% Still two elements max! + ok = ppool:async_queue(Name, [i_am_running, 2000, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 2000, 1, self()]), + noalloc = ppool:run(Name, [i_am_running, 2000, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 500, 1, self()]), + timer:sleep(3500), + L = flush(), + ?_assertMatch([{_, i_am_running}, {_, i_am_running}, {_, i_am_running}], L). + +test_sync_queue(Name) -> + %% Hell yase, two max + {ok, Pid} = ppool:sync_queue(Name, [i_am_running, 200, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 200, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 200, 1, self()]), + {ok, Pid2} = ppool:sync_queue(Name, [i_am_running, 100, 1, self()]), + timer:sleep(300), + L = flush(), + [?_assert(is_pid(Pid)), + ?_assert(is_pid(Pid2)), + ?_assertMatch([{_,i_am_running}, {_,i_am_running}, + {_,i_am_running}, {_,i_am_running}], + L)]. + +test_supervision(Name) -> + ppool:start_pool(Name, 1, {ppool_nagger, start_link, []}), + {ok, Pid} = ppool:run(Name, [sup, 10000, 100, self()]), + ppool:stop_pool(Name), + timer:sleep(100), + ?_assertEqual(undefined, process_info(Pid)). + +test_auth_dealloc(Name) -> + %% Hell yase, two max + {ok, _Pid} = ppool:sync_queue(Name, [i_am_running, 500, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 10000, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 10000, 1, self()]), + ok = ppool:async_queue(Name, [i_am_running, 1, 1, self()]), + timer:sleep(600), + Name ! {'DOWN', make_ref(), process, self(), normal}, + Name ! {'DOWN', make_ref(), process, self(), normal}, + Name ! {'DOWN', make_ref(), process, self(), normal}, + timer:sleep(200), + L = flush(), + ?_assertMatch([{_,i_am_running}], L). + + + +flush() -> + receive + X -> [X|flush()] + after 0 -> + [] + end. + +%% Exported Helper functions +test_mfa(Pid) -> + Pid ! i_am_running. + +wait_mfa(Pid) -> + Pid ! i_am_running, + timer:sleep(3000). diff --git a/learn-you-some-erlang/release/rel/.this-file-intentionally-left-blank b/learn-you-some-erlang/release/rel/.this-file-intentionally-left-blank new file mode 100644 index 0000000..e69de29 -- cgit v1.2.3