path: root/lib/test_server/src/test_server_io.erl

%%
%% %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 they are garbaged
%%  collected by a call to gc/0.

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 directory.

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
		  {group_leader,GL} = process_info(P, group_leader),
		  GL
	      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.