%%
%% %CopyrightBegin%
%%
%% SPDX-License-Identifier: Apache-2.0
%% 
%% Copyright Ericsson AB 2005-2025. 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%
%%

%%
%%----------------------------------------------------------------------
%% Purpose: mstone measurement
%%
%%----------------------------------------------------------------------

-module(megaco_codec_mstone1).
-moduledoc """
This module implements a simple megaco codec-based performance tool.

This module implements the _mstone1_ tool, a simple megaco codec-based
performance tool.

The results, the mstone value(s), are written to stdout.

_Note_ that this module is _not_ included in the runtime part of the
application.
""".


%% API
-export([
	 start/0, start/1, start/2, start/3, start/4,
	 start_flex/0,     start_flex/1,     start_flex/2,
	 start_no_drv/0,   start_no_drv/1,   start_no_drv/2,
	 start_only_drv/0, start_only_drv/1, start_only_drv/2
	]).

%% Internal exports
-export([mstone_runner_init/6]).


-define(LIB, megaco_codec_mstone_lib).

-ifndef(MSTONE_RUN_TIME).
-define(MSTONE_RUN_TIME, 10). % minutes
-endif.

-ifndef(MSTONE_VERSION3).
-define(MSTONE_VERSION3, v3).
-endif.
-define(VERSION3, ?MSTONE_VERSION3).

-ifndef(MSTONE_CODECS).
-define(MSTONE_CODECS, megaco_codec_transform:codecs()).
-endif.

-define(DEFAULT_MESSAGE_PACKAGE, megaco_codec_transform:default_message_package()).
-define(DEFAULT_FACTOR,          1).
-define(DEFAULT_DRV_INCLUDE,     ignore).

%% -define(VERBOSE_STATS,true).

-ifndef(MSTONE_RUNNER_MIN_HEAP_SZ).
-define(MSTONE_RUNNER_MIN_HEAP_SZ,  16#ffff).
-endif.
-define(MSTONE_RUNNER_OPTS, 
        [link, {min_heap_size, ?MSTONE_RUNNER_MIN_HEAP_SZ}]).

-record(mstone, {id, count, codec, econf, heap_size, reds}).


-doc(#{equiv => start/2}).
start() ->
    start(?DEFAULT_FACTOR).


-doc """
start([MessagePackage, RunTime, Factor])

This function is intended to be called from the _mstone1_ script, which
uses the '-s' arguments to run the function (argument order; message package,
run time (in minutes in the example) and factor):

```text
erl -s megaco_codec_mstone1 start time_test 1 1
```

""".

start([Factor]) ->
    start(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor);
start([MessagePackage, Factor]) ->
    start(MessagePackage, ?MSTONE_RUN_TIME, Factor);
start([MessagePackage, RunTime, Factor]) ->
    start(MessagePackage, RunTime, Factor);
start(Factor) ->
    start(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor).

-doc """
start(MessagePackage, Factor)

This function starts the _mstone1_ performance test with all codec configs.
`Factor` (defaults to `1`) processes are started for every supported codec
config.

Each process encodes and decodes their messages. The number of messages
processed in total (for all processes) is the mstone value.

""".

-spec start(RunTime, Factor) -> ok when
      RunTime :: pos_integer(),
      Factor  :: default | pos_integer();
           (MessagePackage, Factor) -> ok when
      MessagePackage :: atom(),
      Factor         :: pos_integer().

start(RunTime, default = _Factor)
  when is_integer(RunTime) andalso (RunTime > 0) ->
    start(?DEFAULT_MESSAGE_PACKAGE, RunTime, ?DEFAULT_FACTOR);
start(RunTime, Factor)
  when is_integer(RunTime) andalso (RunTime > 0) andalso
       is_integer(Factor) andalso (Factor > 0) ->
    start(?DEFAULT_MESSAGE_PACKAGE, RunTime, Factor);
start(MessagePackage, Factor)
  when is_atom(MessagePackage) andalso
       is_integer(Factor) andalso (Factor > 0) ->
    start(MessagePackage, ?MSTONE_RUN_TIME, Factor).

-doc false.
start(Opts, RunTime, Factor) when is_map(Opts) ->
    start(Opts, ?DEFAULT_MESSAGE_PACKAGE, RunTime, Factor);
start(MessagePackage, RunTime, Factor) ->
    start(#{}, MessagePackage, RunTime, Factor).

-doc false.
start(#{bench := Bench},
      MessagePackage, RunTime, Factor) when is_boolean(Bench) ->
    do_start(Bench,
             MessagePackage, RunTime, Factor, ?DEFAULT_DRV_INCLUDE);
start(_,
      MessagePackage, RunTime, Factor) ->
    do_start(false,
             MessagePackage, RunTime, Factor, ?DEFAULT_DRV_INCLUDE).


-doc(#{equiv => start_flex/2}).
start_flex() ->
    start_flex(?DEFAULT_FACTOR).

-doc """
start_flex([MessagePackage, RunTime, Factor])

This function is intended to be called from the _mstone1_ script, which
uses the '-s' arguments to run the function (argument order; message package,
run time (in minutes in the example) and factor):

```text
erl -s megaco_codec_mstone1 start_flex time_test 1 1
```

""".

start_flex([Factor]) ->
    start_flex(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor);
start_flex([MessagePackage, Factor]) ->
    start_flex(MessagePackage, ?MSTONE_RUN_TIME, Factor);
start_flex([MessagePackage, RunTime, Factor]) ->
    start_flex(MessagePackage, RunTime, Factor);
start_flex(Factor) ->
    start_flex(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor).

-doc """
This function starts the _mstone1_ performance test with only the flex codec
configs (i.e. `pretty` and `compact` with `flex`). The same number of processes
are started as when running the standard test (using the `start/0,1` function).
Each process encodes and decodes their messages. The number of messages
processed in total (for all processes) is the mstone value.
""".

-spec start_flex(MessagePackage, Factor) -> ok when
      MessagePackage :: atom(),
      Factor         :: pos_integer().

start_flex(MessagePackage, Factor) ->
    do_start(false,
             MessagePackage, ?MSTONE_RUN_TIME, Factor, flex).

start_flex(MessagePackage, RunTime, Factor) ->
    do_start(false,
             MessagePackage, RunTime, Factor, flex).


-doc(#{equiv => start_only_drv/2}).
start_only_drv() ->
    start_only_drv(?DEFAULT_FACTOR).

-doc """
start_no_drv([MessagePackage, RunTime, Factor])

This function is intended to be called from the _mstone1_ script, which
uses the '-s' arguments to run the function (argument order; message package,
run time (in minutes in the example) and factor):

```text
erl -s megaco_codec_mstone1 start_no_drv time_test 1 1
```

""".

start_only_drv([Factor]) ->
    start_only_drv(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor);
start_only_drv([MessagePackage, Factor]) ->
    start_only_drv(MessagePackage, ?MSTONE_RUN_TIME, Factor);
start_only_drv([MessagePackage, RunTime, Factor]) ->
    start_only_drv(MessagePackage, RunTime, Factor);
start_only_drv(Factor) ->
    start_only_drv(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor).

-doc """
This function starts the _mstone1_ performance test with only the driver using
codec configs (i.e. `pretty` and `compact` with `flex`, and `ber` and `per` with
`driver` and `erlang` with `compressed`). The same number of processes are
started as when running the standard test (using the `start/0,1` function). Each
process encodes and decodes their messages. The number of messages processed in
total (for all processes) is the mstone value.
""".

-spec start_only_drv(MessagePackage, Factor) -> ok when
      MessagePackage :: atom(),
      Factor         :: pos_integer().

start_only_drv(MessagePackage, Factor) ->
    do_start(false,
             MessagePackage, ?MSTONE_RUN_TIME, Factor, only_drv).

start_only_drv(MessagePackage, RunTime, Factor) ->
    do_start(false,
             MessagePackage, RunTime, Factor, only_drv).


-doc(#{equiv => start_no_drv/2}).
start_no_drv() ->
    start_no_drv(?DEFAULT_FACTOR).

-doc """
start_no_drv([MessagePackage, RunTime, Factor])

This function is intended to be called from the _mstone1_ script, which
uses the '-s' arguments to run the function (argument order; message package,
run time (in minutes in the example) and factor):

```text
erl -s megaco_codec_mstone1 start_no_drv time_test 1 1
```

""".

start_no_drv([Factor]) ->
    start_no_drv(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor);
start_no_drv([MessagePackage, Factor]) ->
    start_no_drv(MessagePackage, ?MSTONE_RUN_TIME, Factor);
start_no_drv([MessagePackage, RunTime, Factor]) ->
    start_no_drv(MessagePackage, RunTime, Factor);
start_no_drv(Factor) ->
    start_no_drv(?DEFAULT_MESSAGE_PACKAGE, ?MSTONE_RUN_TIME, Factor).

-doc """
This function starts the _mstone1_ performance test with codec configs not using
any drivers (i.e. `pretty` and `compact` without `flex`, `ber` and `per` without
`driver` and `erlang` without `compressed`). The same number of processes are
started as when running the standard test (using the `start/0,1` function). Each
process encodes and decodes their messages. The number of messages processed in
total (for all processes) is the mstone value.
""".

-spec start_no_drv(MessagePackage, Factor) -> ok when
      MessagePackage :: atom(),
      Factor         :: pos_integer().

start_no_drv(MessagePackage, Factor) ->
    do_start(false,
             MessagePackage, ?MSTONE_RUN_TIME, Factor, no_drv).

start_no_drv(MessagePackage, RunTime, Factor) ->
    do_start(false,
             MessagePackage, RunTime, Factor, no_drv).

    
do_start(Bench,
         MessagePackageRaw, RunTimeRaw, FactorRaw, DrvInclude) ->
    RunTime        = parse_runtime(RunTimeRaw),
    Factor         = parse_factor(FactorRaw),
    MessagePackage = parse_message_package(MessagePackageRaw),
    mstone_init(Bench,
                MessagePackage, RunTime, Factor, DrvInclude).


parse_runtime(RunTimeAtom) ->
    ?LIB:parse_runtime(RunTimeAtom).

parse_factor(FactorAtom) when is_atom(FactorAtom) ->
    case (catch list_to_integer(atom_to_list(FactorAtom))) of
	Factor when is_integer(Factor) andalso (Factor > 0) ->
	    Factor;
	_ ->
	    io:format("ERROR: Bad factor value: ~p~n", [FactorAtom]),
	    throw({error, {bad_factor, FactorAtom}})
    end;
parse_factor(FactorRaw) when is_list(FactorRaw) ->
    case (catch list_to_integer(FactorRaw)) of
	Factor when is_integer(Factor) andalso (Factor > 0) ->
	    Factor;
	_ ->
	    io:format("ERROR: Bad factor value: ~p~n", [FactorRaw]),
	    throw({error, {bad_factor, FactorRaw}})
    end;
parse_factor(Factor) when is_integer(Factor) andalso (Factor > 0) ->
    Factor;
parse_factor(BadFactor) ->
    throw({error, {bad_factor, BadFactor}}).
    

parse_message_package(MessagePackageRaw) when is_list(MessagePackageRaw) ->
    list_to_atom(MessagePackageRaw);
parse_message_package(MessagePackage) when is_atom(MessagePackage) ->
    MessagePackage;
parse_message_package(BadMessagePackage) ->
    throw({error, {bad_message_package, BadMessagePackage}}).


%% Codecs is a list of megaco codec shortnames: 
%%
%%    pretty | compact | ber | per | erlang
%%

mstone_init(Bench,
            MessagePackage, RunTime, Factor, DrvInclude) ->
    %% io:format("MStone init with:"
    %%           "~n   MessagePackage: ~p"
    %%           "~n   RunTime:        ~p ms"
    %%           "~n   Factor:         ~p"
    %%           "~n   DrvInclude:     ~p"
    %%           "~n", [MessagePackage, RunTime, Factor, DrvInclude]),
    Codecs = ?MSTONE_CODECS, 
    mstone_init(Bench,
                MessagePackage, RunTime, Factor, Codecs, DrvInclude).

mstone_init(Bench,
            MessagePackage, RunTime, Factor, Codecs, DrvInclude) ->
    Parent = self(), 
    Pid = spawn(
	    fun() -> 
		    process_flag(trap_exit, true),
		    Done = do_mstone(MessagePackage,
                                     RunTime, Factor, Codecs, DrvInclude),  
		    Parent ! {Done, self()}
	    end),
    receive
	{{ok, _} = OK, Pid} ->
	    mstone_maybe_bench(Bench, OK);
        {{error, _} = ERROR, Pid} ->
            ERROR
    end.

mstone_maybe_bench(true, {ok, MStone}) ->
    {bench, MStone};
mstone_maybe_bench(false, {ok, _}) ->
    ok.
			 
do_mstone(MessagePackage, RunTime, Factor, Codecs, DrvInclude) ->
    io:format("~n", []),
    ?LIB:display_os_info(),
    ?LIB:display_system_info(),
    ?LIB:display_app_info(),
    io:format("~n", []),
    try ?LIB:start_flex_scanner() of
        {Pid, Conf} when is_pid(Pid) ->
            put(flex_scanner_conf, Conf),
            EMessages = ?LIB:expanded_messages(MessagePackage, Codecs, DrvInclude), 
            EMsgs  = duplicate(Factor, EMessages),
            MStone = t1(RunTime, EMsgs),
            ?LIB:stop_flex_scanner(Pid),
            io:format("~n", []),
            io:format("MStone: ~p~n", [MStone]),
            {ok, MStone}
    catch
        throw:{error, Reason} = ERROR ->
            io:format("<ERROR> Failed starting flex scanner: "
                      "~n      ~p", [Reason]),
            ERROR
    end.

duplicate(N, Elements) ->
    duplicate(N, Elements, []).

duplicate(_N, [], Acc) ->
    lists:flatten(Acc);
duplicate(N, [H|T], Acc) ->
    duplicate(N, T, [lists:duplicate(N, H)|Acc]).

t1(RunTime, EMsgs) ->
    io:format(" * starting runners [~w] ", [length(EMsgs)]),
    t1(RunTime, EMsgs, []).

t1(_RunTime, [], Runners) ->
    io:format(" done~n * await runners ready ", []),
    await_runners_ready(Runners),
    io:format(" done~n * now snooze", []),
    receive after 5000 -> ok end,
    io:format("~n * release them~n", []),
    lists:foreach(fun(P) -> P ! {go, self()} end, Runners),
    t2(1, [], Runners);
t1(RunTime, [H|T], Runners) ->
    Runner = init_runner(RunTime, H),
    io:format(".", []),
    t1(RunTime, T, [Runner|Runners]).

await_runners_ready([]) ->
    ok;
await_runners_ready(Runners) ->
    receive
        {ready, Runner} ->
            io:format(".", []),
	    %% i("runner ~w ready", [Runner]),
            await_runners_ready(lists:delete(Runner, Runners));
	{'EXIT', Pid, Reason} ->
	    case lists:member(Pid, Runners) of
		true ->
		    io:format("~nERROR: "
			      "received (unexpected) exit signal "
			      "from from runner ~p:"
			      "~n~p~n", [Pid, Reason]),
		    exit(Reason);
		false ->
		    await_runners_ready(Runners)
	    end
    end.

-ifdef(VERBOSE_STATS).
print_runner_stats(RunnerStats) ->
    Sorted = lists:keysort(2, RunnerStats),
    lists:foreach(fun(#mstone{id        = Id,
			      count     = Num,
                              codec     = Codec,
                              econf     = EConf, 
                              heap_size = HeapSz, 
                              reds      = Reds}) ->
			  i("runner: ~w"
			    "~n   Count:           ~w"
			    "~n   Codec:           ~w"
			    "~n   Encoding config: ~p"
			    "~n   Heap size:       ~p"
			    "~n   Reductions:      ~p", 
			    [Id, Num, Codec, EConf, HeapSz, Reds]) end, 
                  Sorted),
    ok.
-else.
print_runner_stats(_) ->
    ok.
-endif.

t2(_, Acc, []) ->
    i("~n~w runners", [length(Acc)]),
    print_runner_stats(Acc),

    HeapSzAcc = lists:sort([HS || #mstone{heap_size = HS} <- Acc]),
    i("Runner heap size data:"
      "~n   Min: ~w"
      "~n   Max: ~w"
      "~n   Avg: ~w", 
      [hd(HeapSzAcc), 
       hd(lists:reverse(HeapSzAcc)), 
       (lists:sum(HeapSzAcc) div length(HeapSzAcc))]), 
    
    RedsAcc   = lists:sort([R || #mstone{reds = R} <- Acc]),
    i("Runner reductions data:"
      "~n   Min: ~w"
      "~n   Max: ~w"
      "~n   Avg: ~w", 
      [hd(RedsAcc), 
       hd(lists:reverse(RedsAcc)), 
       (lists:sum(RedsAcc) div length(RedsAcc))]), 

    lists:sum([Num || #mstone{count = Num} <- Acc]);
t2(N, Acc, Runners) ->
    receive
	{'EXIT', Pid, {runner_done, Codec, Conf, Num, Info}} ->
            {value, {_, HeapSz}} = lists:keysearch(heap_size,  1, Info),
            {value, {_, Reds}}   = lists:keysearch(reductions, 1, Info),
            MStone = #mstone{id        = N,
			     count     = Num,
                             codec     = Codec,
                             econf     = Conf,
                             heap_size = HeapSz,
                             reds      = Reds},
	    t2(N + 1, [MStone|Acc], lists:delete(Pid, Runners))
    end.

init_runner(RunTime, {Codec, Mod, Conf, Msgs}) ->
    Conf1 = runner_conf(Conf),
    Conf2 = [{version3,?VERSION3}|Conf1],
    Pid   = spawn_opt(?MODULE, mstone_runner_init, 
		      [RunTime, Codec, self(), Mod, Conf2, Msgs],
		      ?MSTONE_RUNNER_OPTS),
    Pid.

runner_conf([flex_scanner]) ->
    get(flex_scanner_conf);
runner_conf(Conf) ->
    Conf.



detect_versions(Codec, _Conf, [], []) ->
    exit({no_messages_found_for_codec, Codec});
detect_versions(_Codec, _Conf, [], Acc) ->
    lists:reverse(Acc);
detect_versions(Codec, Conf, [{_Name, Bin}|Bins], Acc) ->
    Data = ?LIB:detect_version(Codec, Conf, Bin),
    detect_versions(Codec, Conf, Bins, [Data|Acc]).
	    

-doc false.
mstone_runner_init(RunTime, _Codec, Parent, Mod, Conf, Msgs0) ->
    Msgs = detect_versions(Mod, Conf, Msgs0, []),
    warmup(Mod, Conf, Msgs, []),
    Parent ! {ready, self()},
    receive
        {go, Parent} ->
            ok
    end,
    erlang:send_after(RunTime, self(), stop),
    mstone_runner_loop(Parent, Mod, Conf, 0, Msgs).

mstone_runner_loop(Parent, Mod, Conf, N, Msgs1) ->
    receive
        stop ->
            exit({runner_done, Mod, Conf, N, mstone_runner_process_info()})
    after 0 ->
        {Inc, Msgs2} = mstone_all(Mod, Conf, Msgs1, []),
	mstone_runner_loop(Parent, Mod, Conf, N+Inc, Msgs2)
    end.

mstone_runner_process_info() ->
    PI = process_info(self()),
    FL = [heap_size, stack_size, reductions],
    lists:filter(fun({Key, _}) -> lists:member(Key, FL) end, PI).
			  
		      
mstone_all(_Codec, _Conf, [], Acc) ->
    {length(Acc), lists:reverse(Acc)};
mstone_all(Codec, Conf, [{V, Bin}|Bins], Acc) when is_binary(Bin) ->
    {ok, Msg} = apply(Codec, decode_message, [Conf, V, Bin]),
    mstone_all(Codec, Conf, Bins, [{V, Msg}|Acc]);
mstone_all(Codec, Conf, [{V, Msg}|Msgs], Acc) ->
    {ok, Bin} = apply(Codec, encode_message, [Conf, V, Msg]),
    mstone_all(Codec, Conf, Msgs, [{V, Bin}|Acc]).

warmup(_Codec, _Conf, [], Acc) ->
    lists:reverse(Acc);
warmup(Codec, Conf, [{V, M}|Msgs], Acc) ->
%%     io:format("~p warmup -> entry with"
%% 	      "~n   Codec: ~p"
%% 	      "~n   Conf:  ~p"
%% 	      "~n", [self(), Codec, Conf]),
    case (catch apply(Codec, decode_message, [Conf, V, M])) of
        {ok, Msg} ->
            case (catch apply(Codec, encode_message, [Conf, V, Msg])) of
                {ok, Bin} ->
                    warmup(Codec, Conf, Msgs, [Bin|Acc]);
                EncodeError ->
                    emsg("failed encoding message: ~n~p", [EncodeError])
            end;
        DecodeError ->
            emsg("failed decoding message: "
		 "~n   DecodeError: ~p"
		 "~n   V:           ~p"
		 "~n   M:           ~p", [DecodeError, V, M])
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

emsg(F, A) ->
    error_logger:error_msg(F ++ "~n", A).

%% i(F) ->
%%     i(F, []).
i(F, A) ->
    io:format(F ++ "~n", A).

