1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2002-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22%%----------------------------------------------------------------------
23%% Purpose: Measure megaco codec's encoding & decoding time's
24%%
25%% Measurement process consists of:
26%%   For each message in a directory:
27%%     Pre:         Read message from the file, close the file
28%%     Measurement: 1) measure decode
29%%                  2) measure encode (of the previously decoded message)
30%%     Post:        Print average
31%%   For each directory:
32%%     A summery is written, both to the console and to a file,
33%%     in an excel compatible format.
34%%
35%% megaco_codec_meas:t().
36%% megaco_codec_meas:t([pretty, compact]).
37%% megaco_codec_meas:t([per, pretty, compact]).
38%%
39%%----------------------------------------------------------------------
40
41-module(megaco_codec_meas).
42
43%% -compile(export_all).
44
45
46%% API
47%% Avoid warning for local function error/2 clashing with autoimported BIF.
48-compile({no_auto_import,[error/2]}).
49-export([start/0, start/1]).
50-export([start1/0]).
51
52%% Internal exports
53-export([do_measure_codec/7, do_measure_codec_loop/7]).
54-export([flex_scanner_handler/1]).
55
56
57-include_lib("kernel/include/file.hrl").
58
59-define(V3, v3).
60
61-define(MEASURE_TIMEOUT, 100000). % 100 sec
62
63-ifndef(MEASURE_COUNT_TIME).
64-define(MEASURE_COUNT_TIME, 1*1000*1000). % 1 seconds
65-endif.
66
67-ifndef(MEASURE_TIME).
68-define(MEASURE_TIME, 10000).
69-endif.
70
71-ifndef(MEASURE_CODECS).
72-define(MEASURE_CODECS, megaco_codec_transform:codecs()).
73-endif.
74
75-define(DEFAULT_MESSAGE_PACKAGE, megaco_codec_transform:default_message_package()).
76
77-record(stat, {name, ecount, etime, dcount, dtime, size}).
78
79
80%% Runs the measurement on all "official" codecs
81
82start1() ->
83    put(everbose,true),
84    start().
85
86start() ->
87    meas_init(?DEFAULT_MESSAGE_PACKAGE, ?MEASURE_CODECS).
88
89start([MessagePackage]) ->
90    do_start(MessagePackage, ?MEASURE_CODECS);
91start(MessagePackage) ->
92    do_start(MessagePackage, ?MEASURE_CODECS).
93
94do_start(MessagePackageRaw, Codecs) ->
95    MessagePackage = parse_message_package(MessagePackageRaw),
96    meas_init(MessagePackage, Codecs).
97
98parse_message_package(MessagePackageRaw) when is_list(MessagePackageRaw) ->
99    list_to_atom(MessagePackageRaw);
100parse_message_package(MessagePackage) when is_atom(MessagePackage) ->
101    MessagePackage;
102parse_message_package(BadMessagePackage) ->
103    throw({error, {bad_message_package, BadMessagePackage}}).
104
105
106%% Dirs is a list of directories containing files,
107%% each with a single megaco message.
108%%
109%% Note that it is a requirement that each dir has
110%% the name of the codec with which the messages has
111%% been encoded:
112%%
113%%    pretty | compact | ber | per | erlang
114%%
115
116meas_init(MessagePackage, Codecs) ->
117    %% process_flag(trap_exit, true),
118    io:format("~nRun meas on message package: ~p~n~n", [MessagePackage]),
119    display_os_info(),
120    display_system_info(),
121    display_app_info(),
122    io:format("~n", []),
123    Started = os:timestamp(),
124    case megaco_codec_transform:messages(MessagePackage) of
125	Messages when is_list(Messages) ->
126	    ExpandedMessages = expand_messages(Codecs, Messages),
127	    Results = t1(ExpandedMessages, []),
128	    display_time(Started, os:timestamp()),
129	    store_results(Results);
130	Error ->
131	    Error
132    end.
133
134display_os_info() ->
135    V = case os:version() of
136	    {Major, Minor, Release} ->
137		lists:flatten(
138		  io_lib:format("~w.~w.~w", [Major, Minor, Release]));
139	    Str ->
140		Str
141	end,
142    case os:type() of
143	{OsFam, OsName} ->
144	    io:format("OS:                  ~p-~p: ~s~n", [OsFam, OsName, V]);
145	OsFam ->
146	    io:format("OS:                  ~p: ~s~n", [OsFam, V])
147    end.
148
149display_system_info() ->
150    SysArch = string:strip(erlang:system_info(system_architecture),right,$\n),
151    SysVer  = string:strip(erlang:system_info(system_version),right,$\n),
152    io:format("System architecture: ~s~n", [SysArch]),
153    io:format("System version:      ~s~n", [SysVer]),
154    ok.
155
156
157display_app_info() ->
158    display_megaco_info(),
159    display_asn1_info().
160
161display_megaco_info() ->
162    MI = megaco:module_info(),
163    {value, {attributes, Attr}} = lists:keysearch(attributes, 1, MI),
164    {value, {app_vsn,    Ver}}  = lists:keysearch(app_vsn, 1, Attr),
165    FlexStr =
166	case megaco_flex_scanner:is_enabled() of
167	    true ->
168		case megaco_flex_scanner:is_reentrant_enabled() of
169		    true ->
170			"reentrant flex";
171		    false ->
172			"non-reentrant flex"
173		end;
174	    false ->
175		"no flex"
176	end,
177    io:format("Megaco version:      ~s (~s)~n", [Ver, FlexStr]).
178
179display_asn1_info() ->
180    AI = megaco_ber_media_gateway_control_v1:info(),
181    Vsn =
182	case lists:keysearch(vsn, 1, AI) of
183	    {value, {vsn, V}} when is_atom(V) ->
184		atom_to_list(V);
185	    {value, {vsn, V}} when is_list(V) ->
186		V;
187	    _ ->
188		"unknown"
189	end,
190    io:format("ASN.1 version:       ~s~n", [Vsn]).
191
192
193%% {MegaSec, Sec, MicroSec}
194display_time(Start, Fin) ->
195    FormatDate1 = format_timestamp(Start),
196    FormatDate2 = format_timestamp(Fin),
197    FormatDiff  = format_diff(Start, Fin),
198    io:format("Started:  ~s~n", [FormatDate1]),
199    io:format("Finished: ~s~n", [FormatDate2]),
200    io:format("          ~s~n~n~n", [FormatDiff]),
201    ok.
202
203format_timestamp({_N1, _N2, N3} = Now) ->
204    {Date, Time}   = calendar:now_to_datetime(Now),
205    {YYYY,MM,DD}   = Date,
206    {Hour,Min,Sec} = Time,
207    FormatDate =
208        io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w",
209                      [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]),
210    lists:flatten(FormatDate).
211
212format_diff(Start, Fin) ->
213    DateTime1 = calendar:now_to_universal_time(Start),
214    DateTime2 = calendar:now_to_universal_time(Fin),
215    T1 = calendar:datetime_to_gregorian_seconds(DateTime1),
216    T2 = calendar:datetime_to_gregorian_seconds(DateTime2),
217    {_, Diff} = calendar:gregorian_seconds_to_datetime(T2 - T1),
218    Tmp =
219	case Diff of
220	    {0, 0, S} ->
221		io_lib:format("~.2.0w sec", [S]);
222	    {0, M, S} ->
223		io_lib:format("~w min ~.2.0w sec", [M,S]);
224	    {H, M, S} ->
225		io_lib:format("~w hour ~w min ~.2.0w sec", [H,M,S])
226	end,
227    lists:flatten(Tmp).
228
229
230
231t1([], Results) ->
232    lists:reverse(Results);
233t1([{Id, Codec, Conf, _, _} = ECodec|EMsgs], Results) ->
234    case (catch measure(ECodec)) of
235	{'EXIT', Reason} ->
236	    error("measure of codec ~p exited: ~n~p", [Codec, Reason]),
237	    t1(EMsgs, Results);
238	{error, Reason} ->
239	    error("skipping codec ~p: ~n~p", [Codec, Reason]),
240	    t1(EMsgs, Results);
241	{ok, Res} ->
242	    t1(EMsgs, [{Id, Conf, Res}| Results])
243    end.
244
245
246measure({Id, Codec, Conf, Count, Msgs}) ->
247    io:format("measure using codec ~p ~p~n ", [Codec, Conf]),
248    {Init, Conf1} = measure_init(Conf),
249    Conf2 = [{version3,?V3}|Conf1],
250    Res = measure(Id, Codec, Conf2, Msgs, [], Count),
251    measure_fin(Init),
252    Res.
253
254
255expand_messages(Codecs, Messages) ->
256    ECodecs = expand_codecs(Codecs, []),
257    expand_messages(ECodecs, Messages, []).
258
259expand_messages([], _, EMessages) ->
260    lists:reverse(EMessages);
261expand_messages([{Id, Codec, Conf, Count} | ECodecs], Messages, EMessages) ->
262    case lists:keysearch(Id, 1, Messages) of
263	{value, {Id, Msgs}} ->
264	    expand_messages(ECodecs, Messages,
265			    [{Id, Codec, Conf, Count, Msgs}|EMessages]);
266	false ->
267	    exit({error, {no_such_codec_data, Id}})
268    end.
269
270expand_codecs([], ECodecs) ->
271    lists:reverse(lists:flatten(ECodecs));
272expand_codecs([Codec|Codecs], ECodecs) when is_atom(Codec) ->
273    ECodec = expand_codec(Codec),
274    expand_codecs(Codecs, [ECodec|ECodecs]).
275
276expand_codec(Codec) ->
277    case Codec of
278	pretty ->
279	    [{Codec, megaco_pretty_text_encoder, [flex_scanner], 2000},
280	     {Codec, megaco_pretty_text_encoder, [],             1000}];
281	compact ->
282	    [{Codec, megaco_compact_text_encoder, [flex_scanner], 3000},
283	     {Codec, megaco_compact_text_encoder, [],             1500}];
284	ber ->
285	    [{Codec, megaco_ber_encoder, [native],        3000},
286	     {Codec, megaco_ber_encoder, [],              1000}];
287	per ->
288	    [{Codec, megaco_per_encoder, [native],        3000},
289	     {Codec, megaco_per_encoder, [],              1000}];
290	erlang ->
291	    [
292	     {Codec, megaco_erl_dist_encoder, [megaco_compressed,compressed], 500},
293	     {Codec, megaco_erl_dist_encoder, [compressed], 400},
294	     {Codec, megaco_erl_dist_encoder, [megaco_compressed], 10000},
295 	     {Codec, megaco_erl_dist_encoder, [], 10000}
296	    ];
297	Else ->
298	    exit({error, {invalid_codec, Else}})
299    end.
300
301
302measure_init([flex_scanner]) ->
303    start_flex_scanner();
304measure_init(Conf) ->
305    {undefined, Conf}.
306
307
308measure_fin(Pid) when is_pid(Pid) ->
309    stop_flex_scanner(Pid),
310    ok;
311measure_fin(_) ->
312    ok.
313
314
315measure(_Dir, _Codec, _Conf, [], [], _MCount) ->
316    {error, no_messages};
317
318measure(_Dir, _Codec, _Conf, [], Res, _MCount) ->
319
320    Eavg = avg([Etime/Ecnt || #stat{ecount = Ecnt, etime = Etime} <- Res]),
321    Davg = avg([Dtime/Dcnt || #stat{dcount = Dcnt, dtime = Dtime} <- Res]),
322    Savg = avg([Size       || #stat{size = Size} <- Res]),
323
324    io:format("~n  Measurment on ~p messages:"
325	      "~n  Average size:   ~w bytes, "
326	      "~n          encode: ~w microsec, "
327	      "~n          decode: ~w microsec~n~n",
328	      [length(Res), Savg, Eavg, Davg]),
329
330    {ok, lists:reverse(Res)};
331
332measure(Dir, Codec, Conf, [{Name, Bin}|Msgs], Results, MCount) ->
333    io:format(" ~p", [Name]),
334    case (catch do_measure(Dir, Codec, Conf, Name, Bin, MCount)) of
335	{ok, Stat} ->
336	    measure(Dir, Codec, Conf, Msgs, [Stat | Results], MCount);
337
338	{error, S} ->
339	    io:format("~n~s failed: ~n", [Name]),
340	    error(S,[]),
341	    measure(Dir, Codec, Conf, Msgs, Results, MCount);
342
343	{info, S} ->
344	    case get(verbose) of
345		true ->
346		    io:format("~n", []),
347		    info(S,[]);
348		_ ->
349		    io:format("~n~s skipped~n", [Name])
350	    end,
351	    measure(Dir, Codec, Conf, Msgs, Results, MCount)
352
353    end.
354
355
356do_measure(_Id, Codec, Conf, Name, BinMsg, MCount) ->
357    %% io:format("~n~s~n", [binary_to_list(BinMsg)]),
358    {Version, NewBin}  = detect_version(Codec, Conf, BinMsg),
359    {Msg, Dcnt, Dtime} = measure_decode(Codec, Conf, Version, NewBin, MCount),
360    {_,   Ecnt, Etime} = measure_encode(Codec, Conf, Version, Msg, MCount),
361
362    {ok, #stat{name   = Name,
363	       ecount = Ecnt, etime = Etime,
364	       dcount = Dcnt, dtime = Dtime,
365	       size = size(NewBin)}}.
366
367detect_version(Codec, Conf, Bin) ->
368    case (catch Codec:version_of(Conf, Bin)) of
369	{ok, V} ->
370	    io:format("[~w]", [V]),
371	    {ok, M} = Codec:decode_message(Conf, V, Bin),
372	    {ok, NewBin} = Codec:encode_message(Conf, V, M),
373	    io:format("[~w]", [size(NewBin)]),
374	    {V, NewBin};
375	Error ->
376	    io:format("~nversion detection failed:~n~p", [Error]),
377	    Error
378    end.
379
380
381measure_decode(Codec, Conf, Version, Bin, MCount) ->
382    case measure_codec(Codec, decode_message, Conf, Version, Bin, MCount) of
383	{ok, Res} ->
384	    Res;
385	{error, Reason} ->
386	    S = format("decode failed for ~p:~n~p", [Codec, Reason]),
387	    throw({error, S})
388    end.
389
390measure_encode(Codec, Conf, Version, Bin, MCount) ->
391    case measure_codec(Codec, encode_message, Conf, Version, Bin, MCount) of
392	{ok, Res} ->
393	    Res;
394	{error, Reason} ->
395	    S = format("encode failed for ~p:~n~p", [Codec, Reason]),
396	    throw({error, S})
397    end.
398
399
400measure_codec(Codec, Func, Conf, Version, Bin, MCount) ->
401    Pid = spawn_link(?MODULE, do_measure_codec,
402                     [self(), Codec, Func, Conf, Version, Bin, MCount]),
403    receive
404	{measure_result, Pid, Func, Res} ->
405	    {ok, Res};
406	{error, Pid, Error} ->
407	    {error, Error};
408	Else ->
409	    {error, {unexpected_result, Else}}
410    after ?MEASURE_TIMEOUT ->
411	    Info =
412		case (catch process_info(Pid)) of
413		    I when is_list(I) ->
414			exit(Pid, kill),
415			I;
416		    _ ->
417			undefined
418		end,
419	    {error, {timeout, MCount, Info}}
420    end.
421
422
423do_measure_codec(Parent, Codec, Func, Conf, Version, Bin, MCount) ->
424    {ok, Count} = measure_warmup(Codec, Func, Conf, Version, Bin, MCount),
425    Res = timer:tc(?MODULE, do_measure_codec_loop,
426		   [Codec, Func, Conf, Version, Bin, Count, dummy]),
427    case Res of
428	{Time, {ok, M}} ->
429	    %% io:format("~w ", [Time]),
430	    Parent ! {measure_result, self(), Func, {M, Count, Time}};
431	{_Time, Error} ->
432	    Parent ! {error, self(), Error}
433    end,
434    unlink(Parent). % Make sure Parent don't get our exit signal
435
436
437%% This function does more mor less what the real measure function
438%% above does. But with the diff:
439%% 1) Warmup to ensure that all used code are loaded
440%% 2) To aproximate the encoding time, to ensure that
441%%    the real encode is done with enough iterations.
442measure_warmup(Codec, Func, Conf, Version, M, MCount) ->
443    Res = timer:tc(?MODULE, do_measure_codec_loop,
444		   [Codec, Func, Conf, Version, M, MCount, dummy]),
445    case Res of
446	{Time, {ok, _}} ->
447	    %% OK so far, now calculate the count:
448	    Count = round(?MEASURE_COUNT_TIME/(Time/MCount)),
449	    %% io:format("~w ", [Count]),
450	    {ok, Count};
451	{_Time, Error} ->
452	    {error, {warmup_failed, Error}}
453    end.
454
455
456do_measure_codec_loop(_Codec, _Func, _Conf, _Version, _Bin, 0, M) ->
457    {ok, M};
458do_measure_codec_loop(Codec, Func, Conf, Version, Bin, Count, _) ->
459    {ok, M} = apply(Codec, Func, [Conf, Version, Bin]),
460    do_measure_codec_loop(Codec, Func, Conf, Version, Bin, Count - 1, M).
461
462
463%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
464
465store_results(Results) ->
466    io:format("storing: ~n", []),
467    store_excel_message_size(Results),
468    store_excel_decode_time(Results),
469    store_excel_encode_time(Results),
470    store_excel_total_time(Results),
471    io:format("~n", []),
472    ok.
473
474
475store_excel_message_size(Res) ->
476    Filename = "message_size.xls",
477    io:format("  creating ~s~n", [Filename]),
478    {ok, Fd} = file:open(Filename,[write]),
479    Sizes = message_sizes(Res, []),
480    store_excel_tab(Fd, Sizes),
481    ok.
482
483store_excel_decode_time(Res) ->
484    Filename = "decode_time.xls",
485    io:format("  creating ~s~n", [Filename]),
486    {ok, Fd} = file:open(Filename,[write]),
487    Decodes = dec_times(Res, []),
488    store_excel_tab(Fd, Decodes),
489    ok.
490
491store_excel_encode_time(Res) ->
492    Filename = "encode_time.xls",
493    io:format("  creating ~s~n", [Filename]),
494    {ok, Fd} = file:open(Filename,[write]),
495    Encodes = enc_times(Res, []),
496    store_excel_tab(Fd, Encodes),
497    ok.
498
499store_excel_total_time(Res) ->
500    Filename = "total_time.xls",
501    io:format("  creating ~s~n", [Filename]),
502    {ok, Fd} = file:open(Filename,[write]),
503    Totals = tot_times(Res, []),
504    store_excel_tab(Fd, Totals),
505    ok.
506
507
508message_sizes([], Sizes) ->
509    lists:reverse(Sizes);
510message_sizes([{Dir, Conf, Res}|T], Acc) ->
511    Sizes = [Size || #stat{size = Size} <- Res],
512    Avg   = avg(Sizes),
513    message_sizes(T, [{Dir, Conf, Avg, Sizes}|Acc]).
514
515dec_times([], Times) ->
516    lists:reverse(Times);
517dec_times([{Dir, Conf, Res}|T], Acc) ->
518    Times = [Time/Count || #stat{dcount = Count, dtime = Time} <- Res],
519    Avg   = avg(Times),
520    dec_times(T, [{Dir, Conf, Avg, Times}|Acc]).
521
522enc_times([], Times) ->
523    lists:reverse(Times);
524enc_times([{Dir, Conf, Res}|T], Acc) ->
525    Times = [Time/Count || #stat{ecount = Count, etime = Time} <- Res],
526    Avg   = avg(Times),
527    enc_times(T, [{Dir, Conf, Avg, Times}|Acc]).
528
529tot_times([], Times) ->
530    lists:reverse(Times);
531tot_times([{Dir, Conf, Res}|T], Acc) ->
532    Times = [(Etime/Ecnt)+(Dtime/Dcnt) || #stat{ecount = Ecnt,
533						etime  = Etime,
534						dcount = Dcnt,
535						dtime  = Dtime} <- Res],
536    Avg   = avg(Times),
537    tot_times(T, [{Dir, Conf, Avg, Times}|Acc]).
538
539
540avg(Vals) ->
541    round(lists:sum(Vals)/length(Vals)).
542
543
544store_excel_tab(_Fd, []) ->
545    ok; % Just in case there was something wrong with the test
546store_excel_tab(Fd, Res) ->
547    %% For all elements of this list, the Values is of the same length...
548    [{_, _, _, Values}|_] = Res,
549    store_excel_tab_header(Fd, length(Values), 1),
550    store_excel_tab1(Fd, Res).
551
552store_excel_tab1(Fd, []) ->
553    io:format(Fd, "~n", []);
554store_excel_tab1(Fd, [{Dir, Conf, Avg, Values}|T]) when is_list(Conf) ->
555    io:format(Fd, "~s~s (~w)",
556	      [filename:basename(Dir), config_to_string(Conf), Avg]),
557    store_excel_tab_row(Fd, Values),
558    store_excel_tab1(Fd, T).
559
560config_to_string([]) ->
561    "";
562config_to_string([C]) when is_atom(C) ->
563    io_lib:format("_~w", [C]);
564config_to_string([C|Cs]) when is_atom(C) ->
565    lists:flatten(io_lib:format("_~w", [C]) ++ config_to_string(Cs)).
566
567store_excel_tab_header(Fd, 0, _) ->
568    io:format(Fd, "~n", []);
569store_excel_tab_header(Fd, N, M) ->
570    io:format(Fd, "\t~w", [M]),
571    store_excel_tab_header(Fd, N-1, M+1).
572
573store_excel_tab_row(Fd, []) ->
574    io:format(Fd, "~n", []);
575store_excel_tab_row(Fd, [Value|Values]) ->
576    io:format(Fd, "\t~w", [round(Value)]),
577    store_excel_tab_row(Fd, Values).
578
579
580
581
582%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
583
584start_flex_scanner() ->
585    Pid = proc_lib:spawn(?MODULE, flex_scanner_handler, [self()]),
586    receive
587        {flex_scanner_started, Pid, Conf} ->
588            {Pid, [Conf]};
589        {flex_scanner_error, {failed_loading_flex_scanner_driver, Reason}} ->
590            throw({error, {failed_loading_flex_scanner_driver, Reason}});
591        {flex_scanner_error, Reason} ->
592            throw({error, {failed_loading_flex_scanner_driver, Reason}})
593    after 10000 ->
594            exit(Pid, kill),
595            throw({error, {failed_starting_flex_scanner, timeout}})
596    end.
597
598stop_flex_scanner(Pid) ->
599    Pid ! stop_flex_scanner.
600
601flex_scanner_handler(Pid) ->
602    case (catch megaco_flex_scanner:start()) of
603        {ok, Port} when is_port(Port) ->
604            Pid ! {flex_scanner_started, self(), {flex, Port}},
605            flex_scanner_handler(Pid, Port);
606        {ok, Ports} when is_tuple(Ports) ->
607            Pid ! {flex_scanner_started, self(), {flex, Ports}},
608            flex_scanner_handler(Pid, Ports);
609        {error, {load_driver, {open_error, Reason}}} ->
610            Error = {failed_loading_flex_scanner_driver, Reason},
611            Pid ! {flex_scanner_error, Error},
612            exit(Error);
613        Else ->
614            Error = {unknown_result_from_start_flex_scanner, Else},
615            Pid ! {flex_scanner_error, Error},
616            exit(Error)
617    end.
618
619flex_scanner_handler(Pid, PortOrPorts) ->
620    receive
621        {ping, Pinger} ->
622            Pinger ! {pong, self()},
623            flex_scanner_handler(Pid, PortOrPorts);
624        {'EXIT', Port, Reason} ->
625	    case megaco_flex_scanner:is_scanner_port(Port, PortOrPorts) of
626		true ->
627		    Pid ! {flex_scanner_exit, Reason},
628		    exit({flex_scanner_exit, Reason});
629		false ->
630		    info("exit signal from unknown port ~p"
631			 "~n   Reason: ~p", [Port, Reason]),
632		    flex_scanner_handler(Pid, PortOrPorts)
633	    end;
634        stop_flex_scanner ->
635            megaco_flex_scanner:stop(PortOrPorts),
636            exit(normal);
637        Other ->
638            info("flex scanner handler got something:~n~p", [Other]),
639            flex_scanner_handler(Pid, PortOrPorts)
640    end.
641
642
643%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
644
645info(F, A) ->
646    io:format(F ++ "~n", A).
647
648
649error(F, A) ->
650    io:format("ERROR: " ++ F ++ "~n", A).
651
652
653format(F, A) ->
654    lists:flatten(io_lib:format(F, A)).
655