%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 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%
%%
-module(standard_error).
-behaviour(supervisor_bridge).
%% Basic standard i/o server for user interface port.
-export([start_link/0, init/1, terminate/2]).
-define(NAME, standard_error).
-define(PROCNAME_SUP, standard_error_sup).
%% Internal exports
-export([server/1, server/2]).
%% Defines for control ops
-define(CTRL_OP_GET_WINSIZE,100).
%%
%% The basic server and start-up.
%%
-spec start_link() -> 'ignore' | {'error',term()} | {'ok',pid()}.
start_link() ->
supervisor_bridge:start_link({local, ?PROCNAME_SUP}, ?MODULE, []).
-spec terminate(term(), pid()) -> 'ok'.
terminate(_Reason,Pid) ->
(catch exit(Pid,kill)),
ok.
-spec init([]) -> {'error','no_stderror'} | {'ok',pid(),pid()}.
init([]) ->
case (catch start_port([out,binary])) of
Pid when is_pid(Pid) ->
{ok,Pid,Pid};
_ ->
{error,no_stderror}
end.
start_port(PortSettings) ->
Id = spawn(?MODULE,server,[{fd,2,2},PortSettings]),
register(?NAME,Id),
Id.
server(Pid) when is_pid(Pid) ->
process_flag(trap_exit, true),
link(Pid),
run(Pid).
server(PortName,PortSettings) ->
process_flag(trap_exit, true),
Port = open_port(PortName,PortSettings),
run(Port).
run(P) ->
put(unicode,false),
server_loop(P).
server_loop(Port) ->
receive
{io_request,From,ReplyAs,Request} when is_pid(From) ->
do_io_request(Request, From, ReplyAs, Port),
server_loop(Port);
{'EXIT',Port,badsig} -> % Ignore badsig errors
server_loop(Port);
{'EXIT',Port,What} -> % Port has exited
exit(What);
_Other -> % Ignore other messages
server_loop(Port)
end.
get_fd_geometry(Port) ->
case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of
List when is_list(List), length(List) =:= 8 ->
<<W:32/native,H:32/native>> = list_to_binary(List),
{W,H};
_ ->
error
end.
%% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer)
do_io_request(Req, From, ReplyAs, Port) ->
{_Status,Reply} = io_request(Req, Port),
io_reply(From, ReplyAs, Reply).
%% New in R13B
% Wide characters (Unicode)
io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C
put_chars(wrap_characters_to_binary(Chars,Encoding,
case get(unicode) of
true -> unicode;
_ -> latin1
end), Port);
io_request({put_chars,Encoding,Mod,Func,Args}, Port) ->
Result = case catch apply(Mod,Func,Args) of
Data when is_list(Data); is_binary(Data) ->
wrap_characters_to_binary(Data,Encoding,
case get(unicode) of
true -> unicode;
_ -> latin1
end);
Undef ->
Undef
end,
put_chars(Result, Port);
%% BC if called from pre-R13 node
io_request({put_chars,Chars}, Port) ->
io_request({put_chars,latin1,Chars}, Port);
io_request({put_chars,Mod,Func,Args}, Port) ->
io_request({put_chars,latin1,Mod,Func,Args}, Port);
%% New in R12
io_request({get_geometry,columns},Port) ->
case get_fd_geometry(Port) of
{W,_H} ->
{ok,W};
_ ->
{error,{error,enotsup}}
end;
io_request({get_geometry,rows},Port) ->
case get_fd_geometry(Port) of
{_W,H} ->
{ok,H};
_ ->
{error,{error,enotsup}}
end;
io_request({getopts,[]}, Port) ->
getopts(Port);
io_request({setopts,Opts}, Port) when is_list(Opts) ->
setopts(Opts, Port);
io_request({requests,Reqs}, Port) ->
io_requests(Reqs, {ok,ok}, Port);
io_request(R, _Port) -> %Unknown request
{error,{error,{request,R}}}. %Ignore but give error (?)
%% Status = io_requests(RequestList, PrevStat, Port)
%% Process a list of output requests as long as the previous status is 'ok'.
io_requests([R|Rs], {ok,_Res}, Port) ->
io_requests(Rs, io_request(R, Port), Port);
io_requests([_|_], Error, _) ->
Error;
io_requests([], Stat, _) ->
Stat.
%% put_port(DeepList, Port)
%% Take a deep list of characters, flatten and output them to the
%% port.
put_port(List, Port) ->
send_port(Port, {command, List}).
%% send_port(Port, Command)
send_port(Port, Command) ->
Port ! {self(),Command}.
%% io_reply(From, ReplyAs, Reply)
%% The function for sending i/o command acknowledgement.
%% The ACK contains the return value.
io_reply(From, ReplyAs, Reply) ->
From ! {io_reply,ReplyAs,Reply}.
%% put_chars
put_chars(Chars, Port) when is_binary(Chars) ->
put_port(Chars, Port),
{ok,ok};
put_chars(Chars, Port) ->
case catch list_to_binary(Chars) of
Binary when is_binary(Binary) ->
put_chars(Binary, Port);
_ ->
{error,{error,put_chars}}
end.
%% setopts
setopts(Opts0,Port) ->
Opts = proplists:unfold(
proplists:substitute_negations(
[{latin1,unicode}],
Opts0)),
case check_valid_opts(Opts) of
true ->
do_setopts(Opts,Port);
false ->
{error,{error,enotsup}}
end.
check_valid_opts([]) ->
true;
check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false ->
check_valid_opts(T);
check_valid_opts(_) ->
false.
do_setopts(Opts, _Port) ->
case proplists:get_value(unicode,Opts) of
Valid when Valid =:= true; Valid =:= utf8 ->
put(unicode,true);
false ->
put(unicode,false);
undefined ->
ok
end,
{ok,ok}.
getopts(_Port) ->
Uni = {unicode, case get(unicode) of
true ->
true;
_ ->
false
end},
{ok,[Uni]}.
wrap_characters_to_binary(Chars,From,To) ->
TrNl = (whereis(user_drv) =/= undefined),
Limit = case To of
latin1 ->
255;
_Else ->
16#10ffff
end,
unicode:characters_to_binary(
[ case X of
$\n ->
if
TrNl ->
"\r\n";
true ->
$\n
end;
High when High > Limit ->
["\\x{",erlang:integer_to_list(X, 16),$}];
Ordinary ->
Ordinary
end || X <- unicode:characters_to_list(Chars,From) ],unicode,To).
