%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 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%
%%
%% This module implements a process with the registered name 'test_server_io',
%% which has two main responsibilities:
%%
%% * Manage group leader processes (see the test_server_gl module)
%% for test cases. A group_leader process is obtained by calling
%% get_gl/1. Group leader processes will be kept alive as along as
%% the 'test_server_io' process is alive.
%%
%% * Handle output to the common log files (stdout, major, html,
%% unexpected_io).
%%
-module(test_server_io).
-export([start_link/0,stop/0,get_gl/1,set_fd/2,
start_transaction/0,end_transaction/0,print_buffered/1,print/3,
set_footer/1,set_job_name/1,set_gl_props/1]).
-export([init/1,handle_call/3,handle_info/2,terminate/2]).
-record(st, {fds, %Singleton fds (gb_tree)
shared_gl :: pid(), %Shared group leader
gls, %Group leaders (gb_set)
io_buffering=false, %I/O buffering
buffered, %Buffered I/O requests
html_footer, %HTML footer
job_name, %Name of current job.
gl_props, %Properties for GL.
stopping
}).
start_link() ->
case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
{ok,Pid} ->
{ok,Pid};
Other ->
Other
end.
stop() ->
OldGL = group_leader(),
group_leader(self(), self()),
req(stop),
group_leader(OldGL, self()),
ok.
%% get_gl(Shared) -> Pid
%% Shared = boolean()
%% Pid = pid()
%%
%% Return a group leader (a process using the test_server_gl module).
%% If Shared is true, the shared group leader is returned (suitable for
%% running sequential test cases), otherwise a new group leader process
%% is spawned. Group leader processes will live until the
%% 'test_server_io' process is stopped.
get_gl(Shared) when is_boolean(Shared) ->
req({get_gl,Shared}).
%% set_fd(Tag, Fd) -> ok.
%% Tag = major | html | unexpected_io
%% Fd = a file descriptor (as returned by file:open/2)
%%
%% Associate a file descriptor with the given Tag. This
%% Tag can later be used in when calling to print/3.
set_fd(Tag, Fd) ->
req({set_fd,Tag,Fd}).
%% start_transaction()
%%
%% Subsequent calls to print/3 from the process executing start_transaction/0
%% will cause the messages to be buffered instead of printed directly.
start_transaction() ->
req({start_transaction,self()}).
%% end_transaction()
%%
%% End the transaction started by start_transaction/0. Subsequent calls to
%% print/3 will cause the message to be printed directly.
end_transaction() ->
req({end_transaction,self()}).
%% print(From, Tag, Msg)
%% From = pid()
%% Tag = stdout, or any tag that has been registered using set_fd/2
%% Msg = string or iolist
%%
%% Either print Msg to the file identified by Tag, or buffer the message
%% start_transaction/0 has been called from the process From.
%%
%% NOTE: The tags have various special meanings. For example, 'html'
%% is assumed to be a HTML file.
print(From, Tag, Msg) ->
req({print,From,Tag,Msg}).
%% print_buffered(Pid)
%% Pid = pid()
%%
%% Print all messages buffered in the *first* transaction buffered for Pid.
%% (If start_transaction/0 and end_transaction/0 has been called N times,
%% print_buffered/1 must be called N times to print all transactions.)
print_buffered(Pid) ->
req({print_buffered,Pid}).
%% set_footer(IoData)
%%
%% Set a footer for the file associated with the 'html' tag.
%% It will be used by print/3 to print a footer for the HTML file.
set_footer(Footer) ->
req({set_footer,Footer}).
%% set_job_name(Name)
%% Set a name for the currently running job. The name will be used
%% when printing to 'stdout'.
%%
set_job_name(Name) ->
req({set_job_name,Name}).
%% set_gl_props(PropList)
%% Set properties for group leader processes. When a group_leader process
%% is created, test_server_gl:set_props(PropList) will be called.
set_gl_props(PropList) ->
req({set_gl_props,PropList}).
%%% Internal functions.
init([]) ->
process_flag(trap_exit, true),
Empty = gb_trees:empty(),
{ok,Shared} = test_server_gl:start_link(),
{ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
io_buffering=gb_sets:empty(),
buffered=Empty,
html_footer="</body>\n</html>\n",
job_name="<name not set>",
gl_props=[]}}.
req(Req) ->
gen_server:call(?MODULE, Req, infinity).
handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) ->
{ok,Pid} = test_server_gl:start_link(),
test_server_gl:set_props(Pid, Props),
{reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}};
handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) ->
{reply,Shared,St};
handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0}=St) ->
Fds = gb_trees:enter(Tag, Fd, Fds0),
{reply,ok,St#st{fds=Fds}};
handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0,
buffered=Buf0}=St) ->
Buf = case gb_trees:is_defined(Pid, Buf0) of
false -> gb_trees:insert(Pid, queue:new(), Buf0);
true -> Buf0
end,
Buffer = gb_sets:add(Pid, Buffer0),
{reply,ok,St#st{io_buffering=Buffer,buffered=Buf}};
handle_call({print,From,Tag,Str}, _From, St0) ->
St = output(From, Tag, Str, St0),
{reply,ok,St};
handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0,
buffered=Buffered0}=St0) ->
Q0 = gb_trees:get(Pid, Buffered0),
Q = queue:in(eot, Q0),
Buffered = gb_trees:update(Pid, Q, Buffered0),
Buffer = gb_sets:delete_any(Pid, Buffer0),
St = St0#st{io_buffering=Buffer,buffered=Buffered},
{reply,ok,St};
handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) ->
Q0 = gb_trees:get(Pid, Buffered0),
Q = do_print_buffered(Q0, St0),
Buffered = gb_trees:update(Pid, Q, Buffered0),
St = St0#st{buffered=Buffered},
{reply,ok,St};
handle_call({set_footer,Footer}, _From, St) ->
{reply,ok,St#st{html_footer=Footer}};
handle_call({set_job_name,Name}, _From, St) ->
{reply,ok,St#st{job_name=Name}};
handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) ->
test_server_gl:set_props(Shared, Props),
{reply,ok,St#st{gl_props=Props}};
handle_call(stop, From, #st{shared_gl=SGL,gls=Gls0}=St0) ->
St = St0#st{gls=gb_sets:insert(SGL, Gls0),stopping=From},
gc(St),
%% Give the users of the surviving group leaders some
%% time to finish.
erlang:send_after(2000, self(), stop_group_leaders),
{noreply,St}.
handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
Gls = gb_sets:delete_any(Pid, Gls0),
case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
true ->
%% No more group leaders left.
gen_server:reply(From, ok),
{stop,normal,St#st{gls=Gls,stopping=undefined}};
false ->
%% Wait for more group leaders to finish.
{noreply,St#st{gls=Gls}}
end;
handle_info({'EXIT',_Pid,Reason}, _St) ->
exit(Reason);
handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
%% Stop the remaining group leaders.
[test_server_gl:stop(GL) || GL <- gb_sets:to_list(Gls)],
erlang:send_after(2000, self(), kill_group_leaders),
{noreply,St};
handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) ->
[exit(GL, kill) || GL <- gb_sets:to_list(Gls)],
gen_server:reply(From, ok),
{stop,normal,St};
handle_info(Other, St) ->
io:format("Ignoring: ~p\n", [Other]),
{noreply,St}.
terminate(_, _) ->
ok.
output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) ->
case gb_sets:is_member(From, Buffered) of
false ->
do_output(Tag, Str, St),
St;
true ->
Q0 = gb_trees:get(From, Buf0),
Q = queue:in({Tag,Str}, Q0),
Buf = gb_trees:update(From, Q, Buf0),
St#st{buffered=Buf}
end.
do_output(stdout, Str, #st{job_name=undefined}) ->
io:put_chars(Str);
do_output(stdout, Str0, #st{job_name=Name}) ->
Str = io_lib:format("Testing ~s: ~s\n", [Name,Str0]),
io:put_chars(Str);
do_output(Tag, Str, #st{fds=Fds}=St) ->
case gb_trees:lookup(Tag, Fds) of
none ->
S = io_lib:format("\n*** ERROR: ~p, line ~p: No known '~p' log file\n",
[?MODULE,?LINE,Tag]),
do_output(stdout, [S,Str], St);
{value,Fd} ->
try
io:put_chars(Fd, Str),
case Tag of
html -> finalise_table(Fd, St);
_ -> ok
end
catch _:Error ->
S = io_lib:format("\n*** ERROR: ~p, line ~p: Error writing to "
"log file '~p': ~p\n",
[?MODULE,?LINE,Tag,Error]),
do_output(stdout, [S,Str], St)
end
end.
finalise_table(Fd, #st{html_footer=Footer}) ->
case file:position(Fd, {cur,0}) of
{ok,Pos} ->
%% We are writing to a seekable file. Finalise so
%% we get complete valid (and viewable) HTML code.
%% Then rewind to overwrite the finalising code.
io:put_chars(Fd, ["\n</table>\n",Footer]),
file:position(Fd, Pos);
{error,epipe} ->
%% The file is not seekable. We cannot erase what
%% we've already written --- so the reader will
%% have to wait until we're done.
ok
end.
do_print_buffered(Q0, St) ->
Item = queue:get(Q0),
Q = queue:drop(Q0),
case Item of
eot ->
Q;
{Tag,Str} ->
do_output(Tag, Str, St),
do_print_buffered(Q, St)
end.
gc(#st{gls=Gls0}) ->
InUse0 = [begin
case process_info(P, group_leader) of
{group_leader,GL} -> GL;
undefined -> undefined
end
end || P <- processes()],
InUse = ordsets:from_list(InUse0),
Gls = gb_sets:to_list(Gls0),
NotUsed = ordsets:subtract(Gls, InUse),
[test_server_gl:stop(Pid) || Pid <- NotUsed],
ok.
