diff options
author | Ingela Anderton Andin <ingela@erlang.org> | 2019-08-28 17:40:33 +0200 |
---|---|---|
committer | Ingela Anderton Andin <ingela@erlang.org> | 2019-08-29 10:30:20 +0200 |
commit | 8e5d1b747ceff51b1768ea6eb9f5dc2df13d9e47 (patch) | |
tree | c465db8f8330a7bed31dbfcb5e4bf1522b080196 /lib | |
parent | 43da2bb99a0728ec8cb54d57f1c5808c0b9ba298 (diff) | |
download | erlang-8e5d1b747ceff51b1768ea6eb9f5dc2df13d9e47.tar.gz |
common_test: Remove legacy
Diffstat (limited to 'lib')
-rw-r--r-- | lib/common_test/src/Makefile | 3 | ||||
-rw-r--r-- | lib/common_test/src/common_test.app.src | 4 | ||||
-rw-r--r-- | lib/common_test/src/ct_event.erl | 12 | ||||
-rw-r--r-- | lib/common_test/src/ct_framework.erl | 3 | ||||
-rw-r--r-- | lib/common_test/src/ct_run.erl | 91 | ||||
-rw-r--r-- | lib/common_test/src/ct_util.erl | 7 | ||||
-rw-r--r-- | lib/common_test/src/ct_webtool.erl | 1214 | ||||
-rw-r--r-- | lib/common_test/src/ct_webtool_sup.erl | 76 | ||||
-rw-r--r-- | lib/common_test/src/vts.erl | 927 |
9 files changed, 23 insertions, 2314 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 80eaed70bd..76689dab8c 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -62,9 +62,6 @@ MODULES= \ ct_repeat \ ct_telnet_client \ ct_make \ - vts \ - ct_webtool \ - ct_webtool_sup \ unix_telnet \ ct_config \ ct_config_plain \ diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index efebea896c..271bb2335b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -49,10 +49,7 @@ ct_telnet, ct_testspec, ct_util, - ct_webtool, - ct_webtool_sup, unix_telnet, - vts, ct_config, ct_config_plain, ct_config_xml, @@ -72,7 +69,6 @@ ct_util_server, ct_config_server, ct_make_ref, - vts, ct_master, ct_master_logs, test_server_ctrl, diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl index 3689c6bc45..7c6ba28180 100644 --- a/lib/common_test/src/ct_event.erl +++ b/lib/common_test/src/ct_event.erl @@ -221,17 +221,7 @@ handle_event(Event,State=#state{receivers=RecvPids}) -> %% report to master report_event({master,Master},E=#event{name=_Name,node=_Node,data=_Data}) -> - ct_master:status(Master,E); - -%% report to VTS -report_event({vts,VTS},#event{name=Name,node=_Node,data=Data}) -> - if Name == start_info ; - Name == test_stats ; - Name == test_done -> - vts:test_info(VTS,Name,Data); - true -> - ok - end. + ct_master:status(Master,E). %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index bce6420042..367b5f5fdc 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1550,8 +1550,7 @@ report(What,Data) -> end; _ -> ok - end, - catch vts:report(What,Data). + end. add_to_stats(Result) -> Update = fun({Ok,Failed,Skipped={UserSkipped,AutoSkipped}}) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 960252a6fe..b028078332 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -27,13 +27,8 @@ -export([install/1,install/2,run/1,run/2,run/3,run_test/1, run_testspec/1,step/3,step/4,refresh_logs/1]). - -%% Exported for VTS --export([run_make/3,do_run/4,tests/1,tests/2,tests/3]). - - -%% Misc internal functions --export([variables_file_name/1,script_start1/2,run_test2/1]). +%% Misc internal API functions +-export([variables_file_name/1,script_start1/2,run_test2/1, run_make/3]). -include("ct.hrl"). -include("ct_event.hrl"). @@ -51,7 +46,6 @@ -record(opts, {label, profile, - vts, shell, cover, cover_stop, @@ -212,25 +206,19 @@ finish(Tracing, ExitStatus, Args) -> if ExitStatus == interactive_mode -> interactive_mode; true -> - case get_start_opt(vts, true, Args) of - true -> - %% VTS mode, don't halt the node - ok; - _ -> - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> - {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) - end - end + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end. script_start1(Parent, Args) -> @@ -239,7 +227,6 @@ script_start1(Parent, Args) -> %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), - Vts = get_start_opt(vts, true, undefined, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), CoverStop = get_start_opt(cover_stop, @@ -325,8 +312,8 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of - {undefined,undefined} -> + BasicHtml = case proplists:get_value(basic_html, Args) of + undefined -> application:set_env(common_test, basic_html, false), undefined; _ -> @@ -357,7 +344,7 @@ script_start1(Parent, Args) -> application:set_env(common_test, keep_logs, KeepLogs), Opts = #opts{label = Label, profile = Profile, - vts = Vts, shell = Shell, + shell = Shell, cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, @@ -415,8 +402,7 @@ run_or_refresh(Opts = #opts{logdir = LogDir}, Args) -> end end. -script_start2(Opts = #opts{vts = undefined, - shell = undefined}, Args) -> +script_start2(Opts = #opts{shell = undefined}, Args) -> case proplists:get_value(spec, Args) of Specs when Specs =/= [], Specs =/= undefined -> Specs1 = get_start_opt(join_specs, [Specs], Specs, Args), @@ -702,7 +688,7 @@ script_start3(Opts, Args) -> {error,incorrect_start_options}; {undefined,undefined,_} -> - if Opts#opts.vts ; Opts#opts.shell -> + if Opts#opts.shell -> script_start4(Opts#opts{tests = []}, Args); true -> %% no start options, use default "-dir ./" @@ -712,20 +698,6 @@ script_start3(Opts, Args) -> end end. -script_start4(#opts{vts = true, config = Config, event_handlers = EvHandlers, - tests = Tests, logdir = LogDir, logopts = LogOpts}, _Args) -> - ConfigFiles = - lists:foldl(fun({ct_config_plain,CfgFiles}, AllFiles) when - is_list(hd(CfgFiles)) -> - AllFiles ++ CfgFiles; - ({ct_config_plain,CfgFile}, AllFiles) when - is_integer(hd(CfgFile)) -> - AllFiles ++ [CfgFile]; - (_, AllFiles) -> - AllFiles - end, [], Config), - vts:init_data(ConfigFiles, EvHandlers, ?abs(LogDir), LogOpts, Tests); - script_start4(#opts{label = Label, profile = Profile, shell = true, config = Config, event_handlers = EvHandlers, @@ -759,27 +731,6 @@ script_start4(#opts{label = Label, profile = Profile, Error -> Error end; - -script_start4(#opts{vts = true, cover = Cover}, _) -> - case Cover of - undefined -> - script_usage(); - _ -> - %% Add support later (maybe). - io:format("\nCan't run cover in vts mode.\n\n", []) - end, - {error,no_cover_in_vts_mode}; - -script_start4(#opts{shell = true, cover = Cover}, _) -> - case Cover of - undefined -> - script_usage(); - _ -> - %% Add support later (maybe). - io:format("\nCan't run cover in interactive mode.\n\n", []) - end, - {error,no_cover_in_interactive_mode}; - script_start4(Opts = #opts{tests = Tests}, Args) -> do_run(Tests, [], Opts, Args). @@ -850,7 +801,6 @@ script_usage() -> "\n\t [-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t [-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"), io:format("Run tests in web based GUI:\n\n" - "\tct_run -vts [-browser Browser]" "\n\t [-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t [-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t [-dir TestDir1 TestDir2 .. TestDirN] |" @@ -2674,7 +2624,6 @@ get_name(Dir) -> TopDir ++ "." ++ Base end. - run_make(TestDir, Mod, UserInclude) -> run_make(suites, TestDir, Mod, UserInclude, [nowarn_export_all]). diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 9f489e9bfb..470a938c53 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -156,12 +156,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> {error,{already_started,_}} -> ok; _ -> - case whereis(vts) of - undefined -> - ct_event:add_handler(); - VtsPid -> - ct_event:add_handler([{vts,VtsPid}]) - end + ct_event:add_handler() end, %% start ct_config server diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl deleted file mode 100644 index 32d4255217..0000000000 --- a/lib/common_test/src/ct_webtool.erl +++ /dev/null @@ -1,1214 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ct_webtool). --behaviour(gen_server). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The general idea is: %% -%% %% -%% %% -%% 1. Scan through the path for *.tool files and find all the web %% -%% based tools. Query each tool for configuration data. %% -%% 2. Add Alias for Erlscript and html for each tool to %% -%% the webserver configuration data. %% -%% 3. Start the webserver. %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API functions --export([start/0, start/2, stop/0]). - -%% Starting Webtool from a shell script --export([script_start/0, script_start/1]). - -%% Web api --export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). - -%% API against other tools --export([is_localhost/0]). - -%% Debug export s --export([get_tools1/1]). --export([debug/1, stop_debug/0, debug_app/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --include_lib("kernel/include/file.hrl"). --include_lib("stdlib/include/ms_transform.hrl"). - --record(state,{priv_dir,app_data,supvis,web_data,started=[]}). - --define(MAX_NUMBER_OF_WEBTOOLS,256). --define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix --define(DEFAULT_ADDR,{127,0,0,1}). - --define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}). --define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). --define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). --define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool - </TITLE>\r\n</HEAD>\r\n - <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). - --define(HTML_END,"</BODY></HTML>"). - --define(SEND_URL_TIMEOUT,5000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% For debugging only. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Start tracing with -%% debug(Functions). -%% Functions = local | global | FunctionList -%% FunctionList = [Function] -%% Function = {FunctionName,Arity} | FunctionName | -%% {Module, FunctionName, Arity} | {Module,FunctionName} -debug(F) -> - {ok, _} = ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes - {ok, _} = ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - _ = tp(F,MS), - {ok, _} = ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func - ok. -tp(local,MS) -> % all functions - ttb:tpl(?MODULE,MS); -tp(global,MS) -> % all exported functions - ttb:tp(?MODULE,MS); -tp([{M,F,A}|T],MS) -> % Other module - {ok, _} = ttb:tpl(M,F,A,MS), - tp(T,MS); -tp([{M,F}|T],MS) when is_atom(F) -> % Other module - {ok, _} = ttb:tpl(M,F,MS), - tp(T,MS); -tp([{F,A}|T],MS) -> % function/arity - {ok, _} = ttb:tpl(?MODULE,F,A,MS), - tp(T,MS); -tp([F|T],MS) -> % function - {ok, _} = ttb:tpl(?MODULE,F,MS), - tp(T,MS); -tp([],_MS) -> - ok. -stop_debug() -> - ttb:stop([format]). - -debug_app(Mod) -> - {ok, _} = ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), - {ok, _} = ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - {ok, _} = ttb:tp(Mod,MS), - ok. - -out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) - when W==webtool;W==mod_esi-> - io:format("~w: (~p)~ncall ~ts~n", [TS,Pid,ffunc(MFA)]), - [{M,F,length(A)}|S]; -out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> - io:format("~w: (~p)~nreturned from ~ts -> ~tp~n", [TS,Pid,ffunc(MFA),R]), - S; -out(_,_,_,_) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Functions called via script. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -script_start() -> - usage(), - halt(). -script_start([App]) -> - DefaultBrowser = - case os:type() of - {win32,_} -> iexplore; - _ -> firefox - end, - script_start([App,DefaultBrowser]); -script_start([App,Browser]) -> - io:format("Starting webtool...\n"), - {ok, _} = start(), - AvailableApps = get_applications(), - {OSType,_} = os:type(), - case lists:keysearch(App,1,AvailableApps) of - {value,{App,StartPage}} -> - io:format("Starting ~w...\n",[App]), - start_tools([],"app=" ++ atom_to_list(App)), - PortStr = integer_to_list(get_port()), - Url = case StartPage of - "/" ++ Page -> - "http://localhost:" ++ PortStr ++ "/" ++ Page; - _ -> - "http://localhost:" ++ PortStr ++ "/" ++ StartPage - end, - _ = case Browser of - none -> - ok; - iexplore when OSType == win32-> - io:format("Starting internet explorer...\n"), - {ok,R} = win32reg:open(""), - Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", - ok = win32reg:change_key(R,Key), - {ok,Val} = win32reg:value(R,"Path"), - IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), - os:cmd("\"" ++ IExplore ++ "\" " ++ Url); - _ when OSType == win32 -> - io:format("Starting ~tw...\n",[Browser]), - os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); - B when B==firefox; B==mozilla -> - io:format("Sending URL to ~w...",[Browser]), - BStr = atom_to_list(Browser), - SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ - Url ++ ")\'", - Port = open_port({spawn,SendCmd},[exit_status]), - receive - {Port,{exit_status,0}} -> - io:format("done\n"), - ok; - {Port,{exit_status,_Error}} -> - io:format(" not running, starting ~w...\n", - [Browser]), - _ = os:cmd(BStr ++ " " ++ Url), - ok - after ?SEND_URL_TIMEOUT -> - io:format(" failed, starting ~w...\n",[Browser]), - erlang:port_close(Port), - os:cmd(BStr ++ " " ++ Url) - end; - _ -> - io:format("Starting ~tw...\n",[Browser]), - os:cmd(atom_to_list(Browser) ++ " " ++ Url) - end, - ok; - false -> - stop(), - io:format("\n{error,{unknown_app,~p}}\n",[App]), - halt() - end. - -usage() -> - io:format("Starting webtool...\n"), - {ok, _} = start(), - Apps = lists:map(fun({A,_}) -> A end,get_applications()), - io:format( - "\nUsage: start_webtool application [ browser ]\n" - "\nAvailable applications are: ~p\n" - "Default browser is \'iexplore\' (Internet Explorer) on Windows " - "or else \'firefox\'\n", - [Apps]), - stop(). - - -get_applications() -> - gen_server:call(ct_web_tool,get_applications). - -get_port() -> - gen_server:call(ct_web_tool,get_port). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Api functions to the genserver. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% -%---------------------------------------------------------------------- - -start()-> - start(standard_path,standard_data). - -start(Path,standard_data)-> - case get_standard_data() of - {error,Reason} -> - {error,Reason}; - Data -> - start(Path,Data) - end; - -start(standard_path,Data)-> - Path=get_path(), - start(Path,Data); - -start(Path,Port) when is_integer(Port)-> - Data = get_standard_data(Port), - start(Path,Data); - -start(Path,Data0)-> - Data = Data0 ++ rest_of_standard_data(), - case gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]) of - {error, {already_started, Pid}} -> - {ok, Pid}; - Else -> - Else - end. - -stop()-> - gen_server:call(ct_web_tool,stoppit). - -%---------------------------------------------------------------------- -%Web Api functions called by the web -%---------------------------------------------------------------------- -started_tools(Env,Input)-> - gen_server:call(ct_web_tool,{started_tools,Env,Input}). - -toolbar(Env,Input)-> - gen_server:call(ct_web_tool,{toolbar,Env,Input}). - -start_tools(Env,Input)-> - gen_server:call(ct_web_tool,{start_tools,Env,Input}). - -stop_tools(Env,Input)-> - gen_server:call(ct_web_tool,{stop_tools,Env,Input}). -%---------------------------------------------------------------------- -%Support API for other tools -%---------------------------------------------------------------------- - -is_localhost()-> - gen_server:call(ct_web_tool,is_localhost). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%%The gen_server callback functions that builds the webbpages %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -handle_call(get_applications,_,State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), - Tools = ets:select(State#state.app_data,MS), - {reply,Tools,State}; - -handle_call(get_port,_,State)-> - {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), - {reply,Port,State}; - -handle_call({started_tools,_Env,_Input},_,State)-> - {reply,started_tools_page(State),State}; - -handle_call({toolbar,_Env,_Input},_,State)-> - {reply,toolbar(),State}; - -handle_call({start_tools,Env,Input},_,State)-> - {NewState,Page}=start_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call({stop_tools,Env,Input},_,State)-> - {NewState,Page}=stop_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call(stoppit,_From,Data)-> - {stop,normal,ok,Data}; - -handle_call(is_localhost,_From,Data)-> - Result=case proplists:get_value(bind_address, Data#state.web_data) of - ?DEFAULT_ADDR -> - true; - _IpNumber -> - false - end, - {reply,Result,Data}. - - -handle_info(_Message,State)-> - {noreply,State}. - -handle_cast(_Request,State)-> - {noreply,State}. - -code_change(_,State,_)-> - {ok,State}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% The other functions needed by the gen_server behaviour -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% Start the gen_server -%---------------------------------------------------------------------- -init({Path,Config})-> - ct_util:mark_process(), - case filelib:is_dir(Path) of - true -> - {ok, Table} = get_tool_files_data(), - insert_app(?WEBTOOL_ALIAS, Table), - case ct_webtool_sup:start_link() of - {ok, Pid} -> - case start_webserver(Table, Path, Config) of - {ok, _} -> - print_url(Config), - {ok,#state{priv_dir=Path, - app_data=Table, - supvis=Pid, - web_data=Config}}; - {error, Error} -> - {stop, {error, Error}} - end; - Error -> - {stop,Error} - end; - false -> - {stop, {error, error_dir}} - end. - -terminate(_Reason,Data)-> - %%shut down the webbserver - shutdown_server(Data), - %%Shutdown the different tools that are started with application:start - shutdown_apps(Data), - %%Shutdown the supervisor and its children will die - shutdown_supervisor(Data), - ok. - -print_url(ConfigData)-> - Server=proplists:get_value(server_name,ConfigData,"undefined"), - Port=proplists:get_value(port,ConfigData,"undefined"), - {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), - io:format("WebTool is available at http://~ts:~w/~n",[Server,Port]), - io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% begin build the pages -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -%The page that shows the started tools -%---------------------------------------------------------------------- -started_tools_page(State)-> - [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. - -toolbar()-> - [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. - - -start_tools_page(_Env,Input,State)-> - %%io:format("~n======= ~n ~p ~n============~n",[Input]), - case get_tools(Input) of - {tools,Tools}-> - %%io:format("~n======= ~n ~p ~n============~n",[Tools]), - {ok,NewState}=handle_apps(Tools,State,start), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_unstarted_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} - end. - -stop_tools_page(_Env,Input,State)-> - case get_tools(Input) of - {tools,Tools}-> - {ok,NewState}=handle_apps(Tools,State,stop), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_started_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Functions that start and config the webserver -%% 1. Collect the config data -%% 2. Start webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Start the webserver -%---------------------------------------------------------------------- -start_webserver(Data,Path,Config)-> - case get_conf_data(Data,Path,Config) of - {ok,Conf_data}-> - %%io:format("Conf_data: ~p~n",[Conf_data]), - start_server(Conf_data); - {error,Error} -> - {error,{error_server_conf_file,Error}} - end. - -start_server(Conf_data)-> - case inets:start(httpd, Conf_data, stand_alone) of - {ok,Pid}-> - {ok,Pid}; - Error-> - {error,{server_error,Error}} - end. - -%---------------------------------------------------------------------- -% Create config data for the webserver -%---------------------------------------------------------------------- -get_conf_data(Data,Path,Config)-> - Aliases=get_aliases(Data), - ServerRoot = filename:join([Path,"root"]), - MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), - case httpd_conf:load_mime_types(MimeTypesFile) of - {ok,MimeTypes} -> - Config1 = Config ++ Aliases, - Config2 = [{server_root,ServerRoot}, - {document_root,filename:join([Path,"root/doc"])}, - {mime_types,MimeTypes} | - Config1], - {ok,Config2}; - Error -> - Error - end. - -%---------------------------------------------------------------------- -% Control the path for *.tools files -%---------------------------------------------------------------------- -get_tool_files_data()-> - Tools=get_tools1(code:get_path()), - %%io:format("Data : ~p ~n",[Tools]), - get_file_content(Tools). - -%---------------------------------------------------------------------- -%Control that the data in the file really is erlang terms -%---------------------------------------------------------------------- -get_file_content(Tools)-> - Get_data=fun({tool,ToolData}) -> - %%io:format("Data : ~p ~n",[ToolData]), - case proplists:get_value(config_func,ToolData) of - {M,F,A}-> - case catch apply(M,F,A) of - {'EXIT',_} -> - bad_data; - Data when is_tuple(Data) -> - Data; - _-> - bad_data - end; - _ -> - bad_data - end - end, - insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). - -%---------------------------------------------------------------------- -%Insert the data from the file in to the ets:table -%---------------------------------------------------------------------- -insert_file_content(Content)-> - Table=ets:new(app_data,[bag]), - lists:foreach(fun(X)-> - insert_app(X,Table) - end,Content), - {ok,Table}. - -%---------------------------------------------------------------------- -%Control that we got a a tuple of a atom and a list if so add the -%elements in the list to the ets:table -%---------------------------------------------------------------------- -insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> - %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), - lists:foreach( - fun({alias,{erl_alias,Alias,Mods}}) -> - Key_val = {erl_script_alias,{Alias,Mods}}, - %%io:format("Insert: ~p~n",[Key_val]), - ets:insert(Table,{Name,Key_val}); - (Key_val_pair)-> - %%io:format("Insert: ~p~n",[Key_val_pair]), - ets:insert(Table,{Name,Key_val_pair}) - end, - Key_val_list); - -insert_app(_,_)-> - ok. - -%---------------------------------------------------------------------- -% Select all the alias in the database -%---------------------------------------------------------------------- -get_aliases(Data)-> - MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> - {erl_script_alias,Alias}; - ({_,{alias,Alias}}) -> - {alias,Alias} - end), - ets:select(Data,MS). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Helper functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_standard_data(Port)-> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ]. - -get_standard_data()-> - case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of - {error,Reason} -> {error,Reason}; - Port -> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ] - end. - -get_free_port(_Port,0) -> - {error,no_free_port_found}; -get_free_port(Port,N) -> - case gen_tcp:connect("localhost",Port,[]) of - {error, _Reason} -> - Port; - {ok,Sock} -> - gen_tcp:close(Sock), - get_free_port(Port+1,N-1) - end. - -rest_of_standard_data() -> - [ - %% Do not allow the server to be crashed by malformed http-request - {max_header_siz,1024}, - {max_header_action,reply414}, - %% Go on a straight ip-socket - {com_type,ip_comm}, - %% Do not change the order of these module names!! - {modules,[mod_alias, - mod_auth, - mod_esi, - mod_actions, - mod_cgi, - mod_include, - mod_dir, - mod_get, - mod_head, - mod_log, - mod_disk_log]}, - {directory_index,["index.html"]}, - {default_type,"text/plain"} - ]. - - -get_path()-> - code:priv_dir(webtool). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These functions is used to shutdown the webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Shut down the webbserver -%---------------------------------------------------------------------- -shutdown_server(State)-> - {Addr,Port} = get_addr_and_port(State#state.web_data), - inets:stop(httpd,{Addr,Port}). - -get_addr_and_port(Config) -> - Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), - Port = proplists:get_value(port,Config,?DEFAULT_PORT), - {Addr,Port}. - -%---------------------------------------------------------------------- -% Select all apps in the table and close them -%---------------------------------------------------------------------- -shutdown_apps(State)-> - Data=State#state.app_data, - MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), - lists:foreach(fun(Start_app)-> - stop_app(Start_app) - end, - ets:select(Data,MS)). - -%---------------------------------------------------------------------- -%Shuts down the supervisor that supervises tools that is not -%Designed as applications -%---------------------------------------------------------------------- -shutdown_supervisor(State)-> - %io:format("~n==================~n"), - ct_webtool_sup:stop(State#state.supvis). - %io:format("~n==================~n"). - -%---------------------------------------------------------------------- -%close the individual apps. -%---------------------------------------------------------------------- -stop_app({child,_Real_name})-> - ok; - -stop_app({app,Real_name})-> - application:stop(Real_name); - -stop_app({func,_Start,Stop})-> - case Stop of - {M,F,A} -> - catch apply(M,F,A); - _NoStop -> - ok - end. - - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webpage where the user can select if -%% to start apps or to stop apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -toolbar_page()-> - "<TABLE> - <TR> - <TD> - <B>Select Action</B> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> - </TD> - </TR> - </TABLE>". -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webbpage that shows the started apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% started_tools(State)->String (html table) -% State is a record of type state -%---------------------------------------------------------------------- -started_tools(State)-> - Names=get_started_apps(State#state.app_data,State#state.started), - "<TABLE BORDER=1 WIDTH=100%> - "++ make_rows(Names,[],0) ++" - </TABLE>". -%---------------------------------------------------------------------- -%get_started_apps(Data,Started)-> [{web_name,link}] -%selects the started apps from the ets table of apps. -%---------------------------------------------------------------------- - -get_started_apps(Data,Started)-> - SelectData=fun({Name,Link}) -> - {Name,Link} - end, - MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), - - [{"WebTool","/tool_management.html"} | - [SelectData(X) || X <- ets:select(Data,MS)]]. - -%---------------------------------------------------------------------- -% make_rows(List,Result,Fields)-> String (The rows of a htmltable -% List a list of tupler discibed above -% Result an accumulator for the result -% Field, counter that counts the number of cols in each row. -%---------------------------------------------------------------------- -make_rows([],Result,Fields)-> - Result ++ fill_out(Fields); -make_rows([Data|Paths],Result,Field)when Field==0-> - make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); - -make_rows([Path|Paths],Result,Field)when Field==4-> - make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); - -make_rows([Path|Paths],Result,Field)-> - make_rows(Paths,Result ++ make_field(Path),Field+1). - -%---------------------------------------------------------------------- -% make_fields(Path)-> String that is a field i a html table -% Path is a name url tuple {Name,url} -%---------------------------------------------------------------------- -make_field(Path)-> - "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". - - -%---------------------------------------------------------------------- -%get_name({Nae,Url})->String that represents a <A> tag in html. -%---------------------------------------------------------------------- -get_name({Name,Url})-> - "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". - - -%---------------------------------------------------------------------- -% fill_out(Nr)-> String, that represent Nr fields in a html-table. -%---------------------------------------------------------------------- -fill_out(Nr)when Nr==0-> - []; -fill_out(Nr)when Nr==4-> - "<TD WIDTH=\"20%\" > </TD></TR>"; - -fill_out(Nr)-> - "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%%These functions starts applicatons and builds the page showing tools -%%to start -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Controls whether the user selected a tool to start -%---------------------------------------------------------------------- -get_tools(Input)-> - case uri_string:dissect_query(Input) of - []-> - no_tools; - Tools-> - FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, - SelectData= - fun({Name,_Data}) -> string:equal(Name,"app") end, - {tools,[FormatData(X)||X<-Tools,SelectData(X)]} - end. - -%---------------------------------------------------------------------- -% Selects the data to start the applications the user has ordered -% starting of -%---------------------------------------------------------------------- -handle_apps([],State,_Cmd)-> - {ok,State}; - -handle_apps([Tool|Tools],State,Cmd)-> - case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of - []-> - Started = case Cmd of - start -> - [Tool|State#state.started]; - stop -> - lists:delete(Tool,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - ToStart -> - case handle_apps2(ToStart,State,Cmd) of - {ok,NewState}-> - handle_apps(Tools,NewState,Cmd); - _-> - handle_apps(Tools,State,Cmd) - end - end. - -%---------------------------------------------------------------------- -%execute every start or stop data about a tool. -%---------------------------------------------------------------------- -handle_apps2([{Name,Start_data}],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of - ok-> - Started = case Cmd of - start -> - [Name|State#state.started]; - stop -> - - lists:delete(Name,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - _-> - error - end; - -handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of - ok-> - handle_apps2(Rest,State,Cmd); - _-> - error - end. - - -%---------------------------------------------------------------------- -% Handle start and stop of applications -%---------------------------------------------------------------------- - -handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> - Action = case Cmd of - start -> - Start; - _ -> - Stop - end, - case Action of - {M,F,A} -> - case catch apply(M,F,A) of - {'EXIT',_} = Exit-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "~w:~tw(~ts) ->\n" - "~tp\n\n", - [?LINE,Name,M,F,format_args(A),Exit]), - ets:delete(Data,Name); - _OK-> - ok - end; - _NoStart -> - ok - end; - - -handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> - case Cmd of - start -> - case catch supervisor:start_child(Pid,ChildSpec) of - {ok,_}-> - ok; - {ok,_,_}-> - ok; - {error,Reason}-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~tp) ->\n" - "~tp\n\n", - [?LINE,Name,Pid,ChildSpec,{error,Reason}]), - ets:delete(Data,Name); - Error -> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~tp) ->\n" - "~tp\n\n", - [?LINE,Name,Pid,ChildSpec,Error]), - ets:delete(Data,Name) - end; - stop -> - case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of - ok -> - supervisor:delete_child(websup,element(1,ChildSpec)); - _ -> - error - end - end; - - - -handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> - case Cmd of - start -> - case application:start(Real_name,temporary) of - ok-> - io:write(Name), - ok; - {error,{already_started,_}}-> - %% Remove it from the database so we dont start - %% anything already started - ets:match_delete(Data,{Name,{start,{app,Real_name}}}), - ok; - {error,_Reason}=Error-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "application:start(~p,~p) ->\n" - "~tp\n\n", - [?LINE,Name,Real_name,temporary,Error]), - ets:delete(Data,Name) - end; - - stop -> - application:stop(Real_name) - end; - -%---------------------------------------------------------------------- -% If the data is incorrect delete the app -%---------------------------------------------------------------------- -handle_app({Name,Incorrect},Data,_Pid,Cmd)-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not ~w application \'~p\'\n\n" - "Incorrect data: ~tp\n\n", - [?LINE,Cmd,Name,Incorrect]), - ets:delete(Data,Name). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% this functions creates the page that shows the unstarted tools %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -reload_started_apps()-> - "<script> - function reloadCompiledList() - { - parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; - } - </script>". - -show_unstarted_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_available_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Start\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - To Start a Tool: - <UL> - <LI>Select the - checkbox for each tool to - start.</LI> - <LI>Click on the - button marked <EM>Start</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - - - -list_available_apps(State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), - Unstarted_apps= - lists:filter( - fun({Tool,_})-> - false==lists:member(Tool,State#state.started) - end, - ets:select(State#state.app_data,MS)), - case Unstarted_apps of - []-> - "<TR><TD>All tools are started</TD></TR>"; - _-> - list_apps(Unstarted_apps) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% these functions creates the page that shows the started apps %% -%% the user can select to shutdown %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -show_started_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_started_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Stop\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - Stop a Tool: - <UL> - <LI>Select the - checkbox for each tool to - stop.</LI> - <LI>Click on the - button marked <EM>Stop</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - -list_started_apps(State)-> - MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, - State#state.started), - Started_apps= ets:select(State#state.app_data,MS), - case Started_apps of - []-> - "<TR><TD>No tool is started yet.</TD></TR>"; - _-> - list_apps(Started_apps) - end. - - -list_apps(Apps) -> - lists:map(fun({Tool,Name})-> - "<TR><TD> - <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" - ++ atom_to_list(Tool) ++ "\"> - " ++ Name ++ " - </TD></TR>" - end, - Apps). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Collecting the data from the *.tool files %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------- -% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] -% Dirs - [string()] Directory names -% Calls get_tools2/2 recursively for a number of directories -% to retireve the configuration data for the web based tools. -%---------------------------------------- -get_tools1(Dirs)-> - get_tools1(Dirs,[]). - -get_tools1([Dir|Rest],Data) when is_list(Dir) -> - Tools=case filename:basename(Dir) of - %% Dir is an 'ebin' directory, check in '../priv' as well - "ebin" -> - [get_tools2(filename:join(filename:dirname(Dir),"priv")) | - get_tools2(Dir)]; - _ -> - get_tools2(Dir) - end, - get_tools1(Rest,[Tools|Data]); - -get_tools1([],Data) -> - lists:flatten(Data). - -%---------------------------------------- -% get_tools2(Directory) => DataList -% DataList : [WebTuple]|[] -% WebTuple: {tool,[{web,M,F,A}]} -% -%---------------------------------------- -get_tools2(Dir)-> - get_tools2(tool_files(Dir),[]). - -get_tools2([ToolFile|Rest],Data) -> - case get_tools3(ToolFile) of - {tool,WebData} -> - get_tools2(Rest,[{tool,WebData}|Data]); - {error,_Reason} -> - get_tools2(Rest,Data); - nodata -> - get_tools2(Rest,Data) - end; - -get_tools2([],Data) -> - Data. - -%---------------------------------------- -% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata -% Tool: {tool,[KeyValTuple]} -% ToolFile - string() A .tool file -% Now we have the file get the data and sort it out -%---------------------------------------- -get_tools3(ToolFile) -> - case file:consult(ToolFile) of - {error,open} -> - {error,nofile}; - {error,read} -> - {error,format}; - {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> - webdata(ToolInfo); - {ok,[{version,_Vsn},_Info]} -> - {error,old_version}; - {ok,_Other} -> - {error,format} - end. - - -%---------------------------------------------------------------------- -% webdata(TupleList)-> ToolTuple| nodata -% ToolTuple: {tool,[{config_func,{M,F,A}}]} -% -% There are a little unneccesary work in this format but it is extendable -%---------------------------------------------------------------------- -webdata(TupleList)-> - case proplists:get_value(config_func,TupleList,nodata) of - {M,F,A} -> - {tool,[{config_func,{M,F,A}}]}; - _ -> - nodata - end. - - -%============================================================================= -% Functions for getting *.tool configuration files -%============================================================================= - -%---------------------------------------- -% tool_files(Dir) => ToolFiles -% Dir - string() Directory name -% ToolFiles - [string()] -% Return the list of all files in Dir ending with .tool (appended to Dir) -%---------------------------------------- -tool_files(Dir) -> - case file:list_dir(Dir) of - {ok,Files} -> - filter_tool_files(Dir,Files); - {error,_Reason} -> - [] - end. - -%---------------------------------------- -% filter_tool_files(Dir,Files) => ToolFiles -% Dir - string() Directory name -% Files, ToolFiles - [string()] File names -% Filters out the files in Files ending with .tool and append them to Dir -%---------------------------------------- -filter_tool_files(_Dir,[]) -> - []; -filter_tool_files(Dir,[File|Rest]) -> - case filename:extension(File) of - ".tool" -> - [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; - _ -> - filter_tool_files(Dir,Rest) - end. - - -%%%----------------------------------------------------------------- -%%% format functions -ffunc({M,F,A}) when is_list(A) -> - io_lib:format("~w:~tw(~ts)\n",[M,F,format_args(A)]); -ffunc({M,F,A}) when is_integer(A) -> - io_lib:format("~w:~tw/~w\n",[M,F,A]). - -format_args([]) -> - ""; -format_args(Args) -> - Str = lists:append(["~tp"|lists:duplicate(length(Args)-1,",~tp")]), - io_lib:format(Str,Args). diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl deleted file mode 100644 index 04fbbf8745..0000000000 --- a/lib/common_test/src/ct_webtool_sup.erl +++ /dev/null @@ -1,76 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ct_webtool_sup). - --behaviour(supervisor). - -%% External exports --export([start_link/0,stop/1]). - -%% supervisor callbacks --export([init/1]). - -%%%---------------------------------------------------------------------- -%%% API -%%%---------------------------------------------------------------------- -start_link() -> - supervisor:start_link({local,ct_websup},ct_webtool_sup, []). - -stop(Pid)-> - exit(Pid,normal). -%%%---------------------------------------------------------------------- -%%% Callback functions from supervisor -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, {SupFlags, [ChildSpec]}} | -%% ignore | -%% {error, Reason} -%%---------------------------------------------------------------------- -init(_StartArgs) -> - ct_util:mark_process(), - %%Child1 = - %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, - %%{ok,{{simple_one_for_one,5,10},[Child1]}}. - {ok,{{one_for_one,100,10},[]}}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - - - - - - - - - - - - - - - - - - - diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl deleted file mode 100644 index 38e549d2d6..0000000000 --- a/lib/common_test/src/vts.erl +++ /dev/null @@ -1,927 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(vts). - --export([start/0, - init_data/5, - stop/0, - report/2]). - --export([config_data/0, - start_link/0]). - --export([start_page/2, - title_frame/2, - menu_frame/2, - welcome_frame/2, - config_frame/2, - browse_config_file/2, - add_config_file/2, - remove_config_file/2, - run_frame/2, - add_test_dir/2, - remove_test_dir/2, - select_case/2, - select_suite/2, - run_test/2, - result_frameset/2, - result_summary_frame/2, - no_result_log_frame/2, - redirect_to_result_log_frame/2]). - --export([test_info/3]). - --define(START_PAGE,"/vts_erl/vts/start_page"). - --define(tests,vts_tests). - -%% Colors --define(INFO_BG_COLOR,"#C0C0EA"). - --record(state,{tests=[],config=[],event_handler=[],test_runner, - running=0,reload_results=false,start_dir,current_log_dir, - logopts=[],total=0,ok=0,fail=0,skip=0,testruns=[]}). - - -%%%----------------------------------------------------------------- -%%% User API -start() -> - {ok, _} = ct_webtool:start(), - ct_webtool:start_tools([],"app=vts"). - -init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) -> - call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}). - -stop() -> - ct_webtool:stop_tools([],"app=vts"), - ct_webtool:stop(). - -report(What,Data) -> - call({report,What,Data}). - -%%%----------------------------------------------------------------- -%%% Return config data used by ct_webtool -config_data() -> - {ok,LogDir} = - case lists:keysearch(logdir,1,init:get_arguments()) of - {value,{logdir,[LogD]}} -> {ok,filename:absname(LogD)}; - false -> file:get_cwd() - end, - {vts, - [{web_data,{"VisualTestServer",?START_PAGE}}, - {alias,{erl_alias,"/vts_erl",[?MODULE]}}, - {alias,{"/log_dir",LogDir}}, - {start,{child,{{local,?MODULE}, - {?MODULE,start_link,[]}, - permanent,100,worker,[?MODULE]}}} - ]}. - -start_link() -> - case whereis(?MODULE) of - undefined -> - Self = self(), - Pid = spawn_link(fun() -> init(Self) end), - MRef = erlang:monitor(process,Pid), - receive - {Pid,started} -> - erlang:demonitor(MRef, [flush]), - {ok,Pid}; - {'DOWN',MRef,process,_,Reason} -> - {error,{vts,died,Reason}} - end; - Pid -> - {ok,Pid} - end. - -start_page(_Env,_Input) -> - call(start_page). -title_frame(_Env,_Input) -> - call(title_frame). -welcome_frame(_Env,_Input) -> - call(welcome_frame). -menu_frame(_Env,_Input) -> - call(menu_frame). -config_frame(_Env,_Input) -> - call(config_frame). -browse_config_file(_Env,Input) -> - call({browse_config_file,Input}). -add_config_file(_Env,Input) -> - call({add_config_file,Input}). -remove_config_file(_Env,Input) -> - call({remove_config_file,Input}). -run_frame(_Env,_Input) -> - call(run_frame). -add_test_dir(_Env,Input) -> - call({add_test_dir,Input}). -remove_test_dir(_Env,Input) -> - call({remove_test_dir,Input}). -select_suite(_Env,Input) -> - call({select_suite,Input}). -select_case(_Env,Input) -> - call({select_case,Input}). -run_test(_Env,_Input) -> - call(run_test). -result_frameset(_Env,_Input) -> - call(result_frameset). -redirect_to_result_log_frame(_Env,_Input) -> - call(redirect_to_result_log_frame). -result_summary_frame(_Env,_Input) -> - call(result_summary_frame). -no_result_log_frame(_Env,_Input) -> - call(no_result_log_frame). - -aborted() -> - call(aborted). - -test_info(_VtsPid,Type,Data) -> - call({test_info,Type,Data}). - -init(Parent) -> - register(?MODULE,self()), - process_flag(trap_exit,true), - ct_util:mark_process(), - Parent ! {self(),started}, - {ok,Cwd} = file:get_cwd(), - InitState = #state{start_dir=Cwd}, - loop(InitState). - -loop(State) -> - receive - {{init_data,Config,EvHandlers,LogDir,LogOpts,Tests},From} -> - %% ct:pal("State#state.current_log_dir=~p", [State#state.current_log_dir]), - NewState = State#state{config=Config,event_handler=EvHandlers, - current_log_dir=LogDir, - logopts=LogOpts,tests=Tests}, - _ = ct_install(NewState), - return(From,ok), - loop(NewState); - {start_page,From} -> - return(From,start_page1()), - loop(State); - {title_frame,From} -> - return(From,title_frame1()), - loop(State); - {welcome_frame,From} -> - return(From,welcome_frame1()), - loop(State); - {menu_frame,From} -> - return(From,menu_frame1()), - loop(State); - {config_frame,From} -> - return(From,config_frame1(State)), - loop(State); - {{browse_config_file,_Input},From} -> - return(From,ok), - loop(State); - {{add_config_file,Input},From} -> - {Return,State1} = add_config_file1(Input,State), - _ = ct_install(State1), - return(From,Return), - loop(State1); - {{remove_config_file,Input},From} -> - {Return,State1} = remove_config_file1(Input,State), - _ = ct_install(State1), - return(From,Return), - loop(State1); - {run_frame,From} -> - return(From,run_frame1(State)), - loop(State); - {{add_test_dir,Input},From} -> - {Return,State1} = add_test_dir1(Input,State), - return(From,Return), - loop(State1); - {{remove_test_dir,Input},From} -> - {Return,State1} = remove_test_dir1(Input,State), - return(From,Return), - loop(State1); - {{select_suite,Input},From} -> - {Return,State1} = select_suite1(Input,State), - return(From,Return), - loop(State1); - {{select_case,Input},From} -> - {Return,State1} = select_case1(Input,State), - return(From,Return), - loop(State1); - {run_test,From} -> - State1 = run_test1(State), - return(From,redirect_to_result_frameset1()), - loop(State1); - {result_frameset,From} -> - return(From,result_frameset1(State)), - loop(State); - {redirect_to_result_log_frame,From} -> - return(From,redirect_to_result_log_frame1(State)), - loop(State); - {result_summary_frame,From} -> - return(From,result_summary_frame1(State)), - loop(State); - stop_reload_results -> - ok = file:set_cwd(State#state.start_dir), - loop(State#state{reload_results=false}); - {no_result_log_frame,From} -> - return(From,no_result_log_frame1()), - loop(State); - {aborted,From} -> - return(From,ok), - loop(State#state{test_runner=undefined,running=0}); - {{report,What,Data},From} -> - State1 = report1(What,Data,State), - return(From,ok), - loop(State1); - {stop,From} -> - return(From,ok); - {'EXIT',Pid,Reason} -> - case State#state.test_runner of - Pid -> - io:format("Test run error: ~tp\n",[Reason]), - loop(State); - _ -> - loop(State) - end; - {{test_info,_Type,_Data},From} -> - return(From,ok), - loop(State) - end. - -call(Msg) -> - case whereis(?MODULE) of - undefined -> {error,no_proc}; - Pid -> - MRef = erlang:monitor(process,Pid), - Ref = make_ref(), - Pid ! {Msg,{self(),Ref}}, - receive - {Ref, Result} -> - erlang:demonitor(MRef, [flush]), - Result; - {'DOWN',MRef,process,_,Reason} -> - {error,{process_down,Pid,Reason}} - end - end. - -return({To,Ref},Result) -> - To ! {Ref, Result}, - ok. - -run_test1(State=#state{tests=Tests,current_log_dir=LogDir, - logopts=LogOpts}) -> - Self=self(), - RunTest = fun() -> - ct_util:mark_process(), - case ct_run:do_run(Tests,[],LogDir,LogOpts) of - {error,_Reason} -> - aborted(); - _ -> - ok - end, - unlink(Self) - end, - Pid = spawn_link(RunTest), - {Total,Tests1} = - receive - {{test_info,start_info,{_,_,Cases}},From} -> - return(From,ok), - {Cases,Tests}; - EXIT = {'EXIT',_,_} -> - self() ! EXIT, - {0,[]} - after 30000 -> - {0,[]} - end, - State#state{test_runner=Pid,running=length(Tests1), - total=Total,ok=0,fail=0,skip=0,testruns=[]}. - - -ct_install(#state{config=Config,event_handler=EvHandlers, - current_log_dir=LogDir}) -> - ct_run:install([{config,Config},{event_handler,EvHandlers}],LogDir). -%%%----------------------------------------------------------------- -%%% HTML -start_page1() -> - header("Visual Test Server Start Page",start_page_frameset()). - -start_page_frameset() -> - frameset( - "ROWS=\"60,*\"", - [frame(["NAME=\"title\" SRC=\"./title_frame\""]), - frameset( - "COLS=\"150,*\"", - [frame(["NAME=\"menu\" SRC=\"./menu_frame\""]), - frame(["NAME=\"main\" SRC=\"./welcome_frame\""])])]). - - -title_frame1() -> - header(body("BGCOLOR=lightgrey TEXT=darkgreen",title_body())). - -title_body() -> - p("ALIGN=center",font("SIZE=\"+3\"",b("Visual Test Server"))). - -welcome_frame1() -> - header(body(welcome_body())). - -welcome_body() -> - table( - "WIDTH=100% HEIGHT=60%", - [tr("VALIGN=middle", - td("ALIGN=center", - font("SIZE=6", - ["Welcome to the",br(), - "Visual Test Server"])))]). - -menu_frame1() -> - header(body(menu_body())). - -menu_body() -> - [h2("Content"), - ul([ - li(href(["TARGET=\"main\""],"./config_frame","Config")), - li(href(["TARGET=\"main\""],"./run_frame","Run")), - li(href(["TARGET=\"main\""],"./result_frameset","Result")) - ]), - h2("Logs"), - ul([ - li(href(["TARGET=\"new\""],"/log_dir/index.html","Last Runs")), - li(href(["TARGET=\"new\""],"/log_dir/all_runs.html","All Runs")) - ]) - ]. - -config_frame1(State) -> - header("Config",body(config_body(State))). - -config_body(State) -> - Entry = [input("TYPE=file NAME=browse SIZE=40"), - input("TYPE=hidden NAME=file")], - BrowseForm = - form( - "NAME=read_file_form METHOD=post ACTION=\"./browse_config_file\"", - table( - "BORDER=0", - [tr(td("1. Locate config file")), - tr(td(Entry))])), - AddForm = - form( - "NAME=add_file_form METHOD=post ACTION=\"./add_config_file\"", - table( - "BORDER=0", - [tr(td("2. Paste full config file name here")), - tr( - [td(input("TYPE=text NAME=file SIZE=40")), - td("ALIGN=center", - input("TYPE=submit onClick=\"file.value=browse.value;\"" - " VALUE=\"Add\""))])])), - - {Text,RemoveForm} = - case State#state.config of - [] -> - T = "Before running the tests, one or more configuration " - "files may be added. Locate the config file, copy its " - "full name, paste this into the text field below, then " - "click the \"Add\" button.", - R = "", - {T,R}; - Files -> - T = "The currently known configuration files are listed below. " - "To add a file, type the filename in the entry and " - "click the \"Add\" button. " - "To remove a file, select it and click the \"Remove\" " - "button.", - ConfigFiles = [option(File) || File <- Files], - Select = select("NAME=file TITLE=\"Select Config File\"" - " MULTIPLE=true", - ConfigFiles), - R = - form(["NAME=remove_config METHOD=post ", - "ACTION=\"./remove_config_file\""], - table( - "BORDER=0", - [tr(td("ALIGN=center",Select)), - tr(td("ALIGN=center", - input("TYPE=submit VALUE=\"Remove\"")))])), - {T,R} - end, - - [h1("ALIGN=center","Config"), - table( - "WIDTH=450 ALIGN=center CELLPADDING=5", - [tr(td(["BGCOLOR=",?INFO_BG_COLOR],Text)), - tr(td("")), - tr(td("")), - tr(td("ALIGN=left",BrowseForm)), - tr(td("ALIGN=left",AddForm)), - tr(td("ALIGN=left",RemoveForm))])]. - -add_config_file1(Input,State) -> - State1 = - case get_input_data(Input,"file") of - "" -> - State; - File -> - State#state{config=[File|State#state.config]} - end, - Return = config_frame1(State1), - {Return,State1}. - -remove_config_file1(Input,State) -> - Files = get_all_input_data(Input,"file"), - State1 = State#state{config=State#state.config--Files}, - Return = config_frame1(State1), - {Return,State1}. - - - -run_frame1(State) -> - header("Run Test",body(run_body(State))). - -run_body(#state{running=Running}) when Running>0 -> - [h1("ALIGN=center","Run Test"), - p(["Test are ongoing: ",href("./result_frameset","Results")])]; -run_body(State) -> - ConfigList = - case State#state.config of - [] -> - ul(["none"]); - CfgFiles -> - ul([li(File) || File <- CfgFiles]) - end, - ConfigFiles = [h3("Config Files"), - ConfigList], - {ok,CWD} = file:get_cwd(), - CurrWD = [h3("Current Working Directory"), ul(CWD)], - AddDirForm = - form( - "NAME=add_dir_form METHOD=post ACTION=\"./add_test_dir\"", - table( - "BORDER=0", - [tr(td("COLSPAN=2","Enter test directory")), - tr( - [td(input("TYPE=text NAME=dir SIZE=40")), - td("ALIGN=center", - input("TYPE=submit onClick=\"dir.value=browse.value;\"" - " VALUE=\"Add Test Dir\""))])])), - {LoadedTestsTable,Submit} = - case create_testdir_entries(State#state.tests,1) of - [] -> {"",""}; - TestDirs -> - Heading = tr([th(""), - th("ALIGN=left","Directory"), - th("ALIGN=left","Suite"), - th("ALIGN=left","Case")]), - {table("CELLPADDING=5",[Heading,TestDirs]), - submit_button()} - end, - Body = - table( - "WIDTH=450 ALIGN=center", - [tr(td("")), - tr(td("")), - tr(td(ConfigFiles)), - tr(td("")), - tr(td(CurrWD)), - tr(td("")), - tr(td(AddDirForm)), - tr(td("")), - tr(td(LoadedTestsTable)), - tr(td(Submit)) - ]), - [h1("ALIGN=center","Run Test"), Body]. - -create_testdir_entries([{Dir,Suite,Case}|Tests],N) -> - [testdir_entry(Dir,Suite,Case,N)|create_testdir_entries(Tests,N+1)]; -create_testdir_entries([],_N) -> - []. - -testdir_entry(Dir,Suite,Case,N) -> - NStr = vts_integer_to_list(N), - tr([td(delete_button(NStr)), - td(Dir), - td(suite_select(Dir,Suite,NStr)), - td(case_select(Dir,Suite,Case,NStr))]). - -delete_button(N) -> - form(["NAME=remove_dir_form METHOD=post ACTION=\"./remove_test_dir\""], - [input(["TYPE=hidden NAME=dir VALUE=\'",N,"\'"]), - input(["TYPE=submit VALUE=X"])]). - -suite_select(Dir,Suite,N) -> - case filelib:wildcard(filename:join(Dir,"*_SUITE.erl")) of - [] -> - select("NAME=suite TITLE=\"Select suite\"",""); - Suites0 -> - Suites = [filename:basename(filename:rootname(S)) || S <- Suites0], - select("NAME=suite TITLE=\"Select suite\"", - options(["all"|Suites],atom_to_list(Suite),N,"select_suite")) - end. - -case_select(_Dir,all,_,N) -> - select("NAME=case TITLE=\"Select case\"", - options(["all"],"all",N,"select_case")); -case_select(Dir,Suite,Case,N) -> - MakeResult = - case application:get_env(common_test, auto_compile) of - {ok,false} -> - ok; - _ -> - UserInclude = - case application:get_env(common_test, include) of - {ok,UserInclDirs} when length(UserInclDirs) > 0 -> - [{i,UserInclDir} || UserInclDir <- UserInclDirs]; - _ -> - [] - end, - ct_run:run_make(Dir,Suite,UserInclude) - end, - case MakeResult of - ok -> - true = code:add_pathz(Dir), - case catch apply(Suite,all,[]) of - {'EXIT',Reason} -> - io:format("\n~tp\n",[Reason]), - red(["COULD NOT READ TESTCASES!!",br(), - "See erlang shell for info"]); - {skip,_Reason} -> - select("NAME=case TITLE=\"Select case\"", - options(["all"],"all",N,"select_case")); - AllCasesAtoms -> - AllCases = [atom_to_list(C) || C <- AllCasesAtoms, - is_atom(C)], - select("NAME=case TITLE=\"Select case\"", - options(["all"|AllCases],atom_to_list(Case), - N,"select_case")) - end; - _Error -> - red(["COMPILATION ERROR!!",br(), - "See erlang shell for info",br(), - "Reload this page when errors are fixed"]) - end. - - -options([Selected|Elements],Selected,N,Func) -> - [option(["SELECTED ", - "onClick=\"document.location.href=\'./",Func,"?n=",N, - "&selected=",Selected,"\';\""], - Selected)| - options(Elements,Selected,N,Func)]; -options([Element|Elements],Selected,N,Func) -> - [option(["onClick=\"document.location.href=\'./",Func,"?n=",N, - "&selected=",Element,"\';\""], - Element)| - options(Elements,Selected,N,Func)]; -options([],_Selected,_N,_Func) -> - []. - -add_test_dir1(Input, State) -> - State1 = - case get_input_data(Input,"dir") of - "" -> State; - Dir0 -> - Dir = case ct_util:is_test_dir(Dir0) of - true -> Dir0; - false -> ct_util:get_testdir(Dir0, all) - end, - case filelib:is_dir(Dir) of - true -> - Test = ct_run:tests(Dir), - State#state{tests=State#state.tests++Test}; - false -> - State - end - end, - Return = run_frame1(State1), - {Return,State1}. - -remove_test_dir1(Input,State) -> - N = list_to_integer(get_input_data(Input,"dir")), - State1 = State#state{tests=delete_test(N,State#state.tests)}, - Return = run_frame1(State1), - {Return,State1}. - -delete_test(1,[_|T]) -> - T; -delete_test(N,[H|T]) -> - [H|delete_test(N-1,T)]. - -select_suite1(Input,State) -> - N = list_to_integer(get_input_data(Input,"n")), - Suite = list_to_atom(get_input_data(Input,"selected")), - Tests1 = replace_suite(N,Suite,State#state.tests), - State1 = State#state{tests=Tests1}, - Return = run_frame1(State1), - {Return,State1}. - -replace_suite(1,Suite,[{Dir,_,_}|T]) -> - [Test] = ct_run:tests(Dir,Suite), - [Test|T]; -replace_suite(N,Suite,[H|T]) -> - [H|replace_suite(N-1,Suite,T)]. - -select_case1(Input,State) -> - N = list_to_integer(get_input_data(Input,"n")), - Case = list_to_atom(get_input_data(Input,"selected")), - Tests1 = replace_case(N,Case,State#state.tests), - State1 = State#state{tests=Tests1}, - Return = run_frame1(State1), - {Return,State1}. - -replace_case(1,Case,[{Dir,Suite,_}|T]) -> - [Test] = ct_run:tests(Dir,Suite,Case), - [Test|T]; -replace_case(N,Case,[H|T]) -> - [H|replace_case(N-1,Case,T)]. - - -submit_button() -> - form(["NAME=run_test_form METHOD=post ACTION=\"./run_test\""], - [input("TYPE=submit VALUE=\"Run Test\"")]). - - -redirect_to_result_frameset1() -> - Head = - ["<META HTTP-EQUIV=\"refresh\" CONTENT=\"1; URL=./result_frameset\">"], - [header("",Head,body("Please wait..."))]. - -result_frameset1(State) -> - header("Results",result_frameset2(State)). - -result_frameset2(State) -> - ResultLog = - case {State#state.current_log_dir,State#state.running} of - {undefined,0} -> - "./no_result_log_frame"; - {undefined,_} -> - "./redirect_to_result_log_frame"; - {_Dir,0} -> - filename:join(["/log_dir","index.html"]); - {_Dir,_} when State#state.testruns == [] -> - %% crash before first test - "./no_result_log_frame"; - {_Dir,_} -> - {_,CurrentLog} = hd(State#state.testruns), - CurrentLog - end, - frameset( - "COLS=\"200,*\"", - [frame(["NAME=\"result_summary\" SRC=\"./result_summary_frame\""]), - frame(["NAME=\"result_log\" SRC=\"",ResultLog,"\""])]). - -redirect_to_result_log_frame1(State) -> - ResultLog = - case {State#state.testruns,State#state.running} of - {[],0} -> - "./no_result_log_frame"; - {[],_} -> - "./redirect_to_result_log_frame"; - {[{_,CurrentLog}|_],_} -> - CurrentLog - end, - Head = ["<META HTTP-EQUIV=\"refresh\" CONTENT=\"1; URL=",ResultLog,"\">"], - [header("",Head,body("Please wait..."))]. - -result_summary_frame1(State) -> - case {State#state.running,State#state.reload_results} of - {0,false} -> - header("Result Summary",body(result_summary_body(State))); - _ -> - Head = - "<SCRIPT LANGUAGE=\"JavaScript1.2\">\n" - "\n" - "function startReloadInterval() {\n" - " intervalId = setInterval(\"reloadPage()\",5000)\n" - "}\n" - "\n" - "function reloadPage() {\n" - " location.reload()\n" - " parent.result_log.location.reload()\n" -% " parent.result_log.scrollBy(0, window.innerHeight)\n" - "}\n" - "</SCRIPT>\n", - header("Result Summary",Head, - body("onLoad=\"startReloadInterval()\" BGCOLOR=\"#FFFFFF\"", - result_summary_body(State))) - end. - -result_summary_body(State) -> - N = State#state.ok + State#state.fail + State#state.skip, - [h2("Result Summary"), - p([b(vts_integer_to_list(N))," cases executed (of ", - b(vts_integer_to_list(State#state.total)),")"]), - p([green([b(vts_integer_to_list(State#state.ok))," successful"]),br(), - red([b(vts_integer_to_list(State#state.fail))," failed"]),br(), - orange([b(vts_integer_to_list(State#state.skip))," skipped"])]), - executed_test_list(State)]. - -executed_test_list(#state{testruns=[]}) -> - []; -executed_test_list(#state{testruns=TestRuns}) -> - [h2("Executed Tests"), - table( - "", - [tr(td(href("TARGET=\"result_log\"",Log,Name))) || - {Name,Log} <- lists:reverse(TestRuns)])]. - - -no_result_log_frame1() -> - header("Test Results",body(no_result_log_body())). - -no_result_log_body() -> - [h1("ALIGN=center","Test Results"), - p(["There are currently no test results available. ", - br(),href("TARGET=\"main\"","./run_frame","You can run tests here")])]. - -report1(tests_start,{TestName,_N},State) -> - {ok,LogDir} = ct_logs:get_log_dir(), - TestRuns = - case State#state.testruns of - [{TestName,_}|_]=TR -> - TR; - TR -> - [{TestName,get_test_log(TestName,LogDir)}|TR] - end, - State#state{testruns=TestRuns}; -report1(tests_done,{_Ok,_Fail,_Skip},State) -> - {ok, _} = timer:send_after(5000, self(),stop_reload_results), - State#state{running=State#state.running-1,reload_results=true}; -report1(tc_start,{_Suite,_Case},State) -> - State; -report1(tc_done,{_Suite,init_per_suite,_},State) -> - State; -report1(tc_done,{_Suite,end_per_suite,_},State) -> - State; -report1(tc_done,{_Suite,init_per_group,_},State) -> - State; -report1(tc_done,{_Suite,end_per_group,_},State) -> - State; -report1(tc_done,{_Suite,_Case,ok},State) -> - State#state{ok=State#state.ok+1}; -report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> - State#state{fail=State#state.fail+1}; -report1(tc_done,{_Suite,_Case,{skipped,_Reason}},State) -> - State#state{skip=State#state.skip+1}; -report1(tc_user_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}; -report1(tc_auto_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}; -report1(loginfo,_,State) -> - State. - -get_test_log(TestName,LogDir) -> - [Log] = - filelib:wildcard( - filename:join([TestName++".logs","run*","suite.log.html"])), - filename:join(["/log_dir",LogDir,Log]). - - - -%get_description(Suite,Case) -> -% case erlang:function_exported(Suite,Case,0) of -% true -> -% case catch apply(Suite,Case,[]) of -% {'EXIT',_Reason} -> -% "-"; -% Info -> -% case lists:keysearch(doc,1,Info) of -% {value,{doc,Doc}} when is_list(Doc) -> -% Doc; -% _ -> -% "-" -% end -% end; -% false -> -% "-" -% end. - -%%%----------------------------------------------------------------- -%%% Internal library -header(Body) -> - header("","",Body). -header(Title,Body) -> - header(Title,"",Body). -header(Title,Head,Body) -> - ["Pragma:no-cache\r\n", - "Content-type: text/html\r\n\r\n", - html_header(Title,Head,Body)]. - -html_header(Title,Head,Body) -> - ["<HTML>\n", - "<HEAD>\n", - "<TITLE>", Title, "</TITLE>\n", - Head, - "</HEAD>\n", - Body, - "</HTML>"]. - -body(Text) -> - ["<BODY BGCOLOR=\"#FFFFFF\">\n",Text,"<\BODY>\n"]. -body(Args,Text) -> - ["<BODY ", Args, ">\n", Text,"<\BODY>\n"]. - - -frameset(Args,Frames) -> - ["<FRAMESET ",Args,">\n", Frames, "\n</FRAMESET>\n"]. -frame(Args) -> - ["<FRAME ",Args, ">\n"]. - -table(Args,Text) -> - ["<TABLE ", Args, ">\n", Text, "\n</TABLE>\n"]. -tr(Text) -> - ["<TR>\n", Text, "\n</TR>\n"]. -tr(Args,Text) -> - ["<TR ", Args, ">\n", Text, "\n</TR>\n"]. -th(Text) -> - ["<TH>", Text, "</TH>"]. -th(Args,Text) -> - ["<TH ", Args, ">\n", Text, "\n</TH>\n"]. -td(Text) -> - ["<TD>", Text, "</TD>"]. -td(Args,Text) -> - ["<TD ", Args, ">", Text, "</TD>"]. - -b(Text) -> - ["<B>",Text,"</B>"]. -%em(Text) -> -% ["<EM>",Text,"</EM>\n"]. -%pre(Text) -> -% ["<PRE>",Text,"</PRE>"]. -href(Link,Text) -> - ["<A HREF=\"",Link,"\">",Text,"</A>"]. -href(Args,Link,Text) -> - ["<A HREF=\"",Link,"\" ",Args,">",Text,"</A>"]. -form(Args,Text) -> - ["<FORM ",Args,">\n",Text,"\n</FORM>\n"]. -input(Args) -> - ["<INPUT ", Args, ">\n"]. -select(Args,Text) -> - ["<SELECT ", Args, ">\n", Text, "\n</SELECT>\n"]. -option(Text) -> - ["<OPTION>\n", Text, "\n</OPTION>\n"]. -option(Args,Text) -> - ["<OPTION ", Args, ">\n", Text, "\n</OPTION>\n"]. -h1(Args,Text) -> - ["<H1 ", Args, ">",Text,"</H1>\n"]. -h2(Text) -> - ["<H2>",Text,"</H2>\n"]. -h3(Text) -> - ["<H3>",Text,"</H3>\n"]. -%%h4(Text) -> -%% ["<H4>",Text,"</H4>\n"]. -font(Args,Text) -> - ["<FONT ",Args,">\n",Text,"\n</FONT>\n"]. -p(Text) -> - ["<P>",Text,"</P>\n"]. -p(Args, Text) -> - ["<P ", Args, ">",Text,"</P>\n"]. -ul(Text) -> - ["<UL>", Text, "</UL>\n"]. -li(Text) -> - ["<LI>", Text, "</LI>\n"]. -br() -> - "<BR>\n". - -red(Text) -> color(red,Text). -green(Text) -> color(green,Text). -orange(Text) -> color(orange,Text). -color(Color,Text) when is_atom(Color) -> - font(["COLOR=",atom_to_list(Color)],Text). - -get_all_input_data(Input,Key)-> - List = parse(Input), - get_all_input_data(List,Key,[]). -get_all_input_data([{Key,Value}|List],Key,Acc) -> - get_all_input_data(List,Key,[Value|Acc]); -get_all_input_data([{_OtherKey,_Value}|List],Key,Acc) -> - get_all_input_data(List,Key,Acc); -get_all_input_data([],_Key,Acc) -> - Acc. - -get_input_data(Input,Key)-> - case lists:keysearch(Key,1,parse(Input)) of - {value,{Key,Value}} -> - Value; - false -> - undefined - end. - -parse(Input) -> - uri_string:dissect_query(Input). - -vts_integer_to_list(X) when is_atom(X) -> - atom_to_list(X); -vts_integer_to_list(X) when is_integer(X) -> - integer_to_list(X). |