The R13B03 release.OTP_R13B03

1 files changed, 337 insertions, 0 deletions

diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl
new file mode 100644
index 0000000000..af1a920efd
--- /dev/null
+++ b/lib/percept/src/percept.erl
@@ -0,0 +1,337 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2007-2009. 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%
+%% 
+
+%% 
+%% @doc Percept - Erlang Concurrency Profiling Tool
+%%
+%%	This module provides the user interface for the application.
+%% 
+
+-module(percept).
+-behaviour(application).
+-export([
+	profile/1, 
+	profile/2, 
+	profile/3,
+	stop_profile/0, 
+	start_webserver/0, 
+	start_webserver/1, 
+	stop_webserver/0, 
+	stop_webserver/1, 
+	analyze/1,
+	% Application behaviour
+	start/2, 
+	stop/1]).
+
+
+-include("percept.hrl").
+
+%%==========================================================================
+%%
+%% 		Type definitions 
+%%
+%%==========================================================================
+
+%% @type percept_option() = procs | ports | exclusive
+
+-type(percept_option() :: 'procs' | 'ports' | 'exclusive' | 'scheduler').
+
+%%==========================================================================
+%%
+%% 		Application callback functions
+%%
+%%==========================================================================
+
+%% @spec start(Type, Args) -> {started, Hostname, Port} | {error, Reason} 
+%% @doc none
+%% @hidden
+
+start(_Type, _Args) ->
+    %% start web browser service
+    start_webserver(0).
+
+%% @spec stop(State) -> ok 
+%% @doc none
+%% @hidden
+
+stop(_State) ->
+    %% stop web browser service
+    stop_webserver(0).
+
+%%==========================================================================
+%%
+%% 		Interface functions
+%%
+%%==========================================================================
+
+%% @spec profile(Filename::string()) -> {ok, Port} | {already_started, Port}
+%% @see percept_profile
+
+%% profiling
+
+-spec(profile/1 :: (Filename :: string()) -> 
+	{'ok', port()} | {'already_started', port()}).
+
+profile(Filename) ->
+    percept_profile:start(Filename, [procs]).
+
+%% @spec profile(Filename::string(), [percept_option()]) -> {ok, Port} | {already_started, Port}
+%% @see percept_profile
+
+-spec(profile/2 :: (
+	Filename :: string(),
+	Options :: [percept_option()]) ->
+	{'ok', port()} | {'already_started', port()}).
+
+profile(Filename, Options) ->
+    percept_profile:start(Filename, Options). 
+
+%% @spec profile(Filename::string(), MFA::mfa(), [percept_option()]) -> ok | {already_started, Port} | {error, not_started}
+%% @see percept_profile
+
+-spec(profile/3 :: (
+	Filename :: string(),
+	Entry :: {atom(), atom(), list()},
+	Options :: [percept_option()]) ->
+	'ok' | {'already_started', port()} | {'error', 'not_started'}).
+
+profile(Filename, MFA, Options) ->
+    percept_profile:start(Filename, MFA, Options).
+
+-spec(stop_profile/0 :: () -> 'ok' | {'error', 'not_started'}).
+
+%% @spec stop_profile() -> ok | {'error', 'not_started'}
+%% @see percept_profile
+
+stop_profile() ->
+    percept_profile:stop().
+
+%% @spec analyze(string()) -> ok | {error, Reason} 
+%% @doc Analyze file.
+
+-spec(analyze/1 :: (Filename :: string()) -> 
+	'ok' | {'error', any()}).
+
+analyze(Filename) ->
+    case percept_db:start() of 
+	{started, DB} ->
+	    parse_and_insert(Filename,DB);
+	{restarted, DB} ->
+	    parse_and_insert(Filename,DB)
+    end.
+
+%% @spec start_webserver() -> {started, Hostname, Port} | {error, Reason}
+%%	Hostname = string()
+%%	Port = integer()
+%%	Reason = term() 
+%% @doc Starts webserver.
+
+-spec(start_webserver/0 :: () -> 
+	{'started', string(), pos_integer()} | 
+	{'error', any()}).
+
+start_webserver() ->
+    start_webserver(0).
+
+%% @spec start_webserver(integer()) -> {started, Hostname, AssignedPort} | {error, Reason}
+%%	Hostname = string()
+%%	AssignedPort = integer()
+%%	Reason = term() 
+%% @doc Starts webserver. If port number is 0, an available port number will 
+%%	be assigned by inets.
+
+-spec(start_webserver/1 :: (Port :: non_neg_integer()) -> 
+	{'started', string(), pos_integer()} | 
+	{'error', any()}).
+
+start_webserver(Port) when is_integer(Port) ->
+    application:load(percept),
+    case whereis(percept_httpd) of
+	undefined ->
+	    {ok, Config} = get_webserver_config("percept", Port),
+	    inets:start(),
+	    case inets:start(httpd, Config) of
+		{ok, Pid} ->
+		    AssignedPort = find_service_port_from_pid(inets:services_info(), Pid),
+		    {ok, Host} = inet:gethostname(),
+		    %% workaround until inets can get me a service from a name.
+		    Mem = spawn(fun() -> service_memory({Pid,AssignedPort,Host}) end),
+		    register(percept_httpd, Mem),
+		    {started, Host, AssignedPort};
+		{error, Reason} ->
+		    {error, {inets, Reason}}
+	   end;
+	_ ->
+	    {error, already_started}
+    end.
+
+%% @spec stop_webserver() -> ok | {error, not_started}  
+%% @doc Stops webserver.
+
+stop_webserver() ->
+    case whereis(percept_httpd) of
+    	undefined -> 
+	    {error, not_started};
+	Pid ->
+	    Pid ! {self(), get_port},
+	    receive Port -> ok end,
+	    Pid ! quit,
+	    stop_webserver(Port)
+    end.
+
+%% @spec stop_webserver(integer()) -> ok | {error, not_started}
+%% @doc Stops webserver of the given port.
+%% @hidden
+
+stop_webserver(Port) ->
+    case find_service_pid_from_port(inets:services_info(), Port) of
+	undefined ->
+	    {error, not_started};
+	Pid ->
+	    inets:stop(httpd, Pid)
+    end. 
+
+%%==========================================================================
+%%
+%% 		Auxiliary functions 
+%%
+%%==========================================================================
+
+%% parse_and_insert
+
+parse_and_insert(Filename, DB) ->
+    io:format("Parsing: ~p ~n", [Filename]),
+    T0 = erlang:now(),
+    Pid = dbg:trace_client(file, Filename, mk_trace_parser(self())),
+    Ref = erlang:monitor(process, Pid), 
+    parse_and_insert_loop(Filename, Pid, Ref, DB, T0).
+
+parse_and_insert_loop(Filename, Pid, Ref, DB, T0) ->
+    receive
+	{'DOWN',Ref,process, Pid, noproc} ->
+	    io:format("Incorrect file or malformed trace file: ~p~n", [Filename]),
+	    {error, file};
+    	{parse_complete, {Pid, Count}} ->
+	    receive {'DOWN', Ref, process, Pid, normal} -> ok after 0 -> ok end,
+	    DB ! {action, consolidate},
+	    T1 = erlang:now(),
+	    io:format("Parsed ~p entries in ~p s.~n", [Count, ?seconds(T1, T0)]),
+    	    io:format("    ~p created processes.~n", [length(percept_db:select({information, procs}))]),
+     	    io:format("    ~p opened ports.~n", [length(percept_db:select({information, ports}))]),
+	    ok;
+	{'DOWN',Ref, process, Pid, normal} -> parse_and_insert_loop(Filename, Pid, Ref, DB, T0);
+	{'DOWN',Ref, process, Pid, Reason} -> {error, Reason}
+    end.
+
+mk_trace_parser(Pid) -> 
+    {fun trace_parser/2, {0, Pid}}.
+
+trace_parser(end_of_trace, {Count, Pid}) -> 
+    Pid ! {parse_complete, {self(),Count}},
+    receive
+	{ack, Pid} -> 
+	    ok
+    end;
+trace_parser(Trace, {Count, Pid}) ->
+    percept_db:insert(Trace),
+    {Count + 1,  Pid}.
+
+find_service_pid_from_port([], _) ->
+    undefined;
+find_service_pid_from_port([{_, Pid, Options} | Services], Port) ->
+    case lists:keysearch(port, 1, Options) of
+	false ->
+	    find_service_pid_from_port(Services, Port);
+	{value, {port, Port}} ->
+	    Pid
+    end.
+
+find_service_port_from_pid([], _) ->
+    undefined;
+find_service_port_from_pid([{_, Pid, Options} | _], Pid) ->
+    case lists:keysearch(port, 1, Options) of
+	false ->
+	    undefined;
+	{value, {port, Port}} ->
+	   Port
+    end;
+find_service_port_from_pid([{_, _, _} | Services], Pid) ->
+    find_service_port_from_pid(Services, Pid).
+    
+%% service memory
+
+service_memory({Pid, Port, Host}) ->
+    receive
+	quit -> 
+	    ok;
+	{Reply, get_port} ->
+	    Reply ! Port,
+	    service_memory({Pid, Port, Host});
+	{Reply, get_host} -> 
+	    Reply ! Host,
+	    service_memory({Pid, Port, Host});
+	{Reply, get_pid} -> 
+	    Reply ! Pid,
+	    service_memory({Pid, Port, Host})
+    end.
+
+% Create config data for the webserver 
+
+get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port) ->
+    Path = code:priv_dir(percept),
+    Root = filename:join([Path, "server_root"]),
+    MimeTypesFile = filename:join([Root,"conf","mime.types"]),
+    {ok, MimeTypes} = httpd_conf:load_mime_types(MimeTypesFile),
+    Config = [
+	% Roots
+	{server_root, Root},
+	{document_root,filename:join([Root, "htdocs"])},
+	
+	% Aliases
+	{eval_script_alias,{"/eval",[io]}},
+	{erl_script_alias,{"/cgi-bin",[percept_graph,percept_html,io]}},
+	{script_alias,{"/cgi-bin/", filename:join([Root, "cgi-bin"])}},
+	{alias,{"/javascript/",filename:join([Root, "scripts"]) ++ "/"}},
+	{alias,{"/images/", filename:join([Root, "images"]) ++ "/"}},
+	{alias,{"/css/", filename:join([Root, "css"]) ++ "/"}},
+	
+	% Logs
+	%{transfer_log, filename:join([Path, "logs", "transfer.log"])},
+	%{error_log, filename:join([Path, "logs", "error.log"])},
+	
+	% Configs
+	{default_type,"text/plain"},
+	{directory_index,["index.html"]},
+	{mime_types, MimeTypes},
+	{modules,[mod_alias,
+	          mod_esi,
+	          mod_actions,
+	          mod_cgi,
+	          mod_include,
+	          mod_dir,
+	          mod_get,
+	          mod_head
+	%          mod_log,
+	%          mod_disk_log
+	]},
+	{com_type,ip_comm},
+	{server_name, Servername},
+	{bind_address, any},
+	{port, Port}],
+    {ok, Config}.