filename.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 778 行 · 第 1/2 页

    relative.

win32_pathtype([List|Rest]) when is_list(List) ->
    win32_pathtype(List++Rest);
win32_pathtype([Atom|Rest]) when is_atom(Atom) ->
    win32_pathtype(atom_to_list(Atom)++Rest);
win32_pathtype([Char, List|Rest]) when is_list(List) ->
    win32_pathtype([Char|List++Rest]);
win32_pathtype([$/, $/|_]) -> absolute;
win32_pathtype([$\\, $/|_]) -> absolute;
win32_pathtype([$/, $\\|_]) -> absolute;
win32_pathtype([$\\, $\\|_]) -> absolute;
win32_pathtype([$/|_]) -> volumerelative;
win32_pathtype([$\\|_]) -> volumerelative;
win32_pathtype([C1, C2, List|Rest]) when is_list(List) ->
    pathtype([C1, C2|List++Rest]);
win32_pathtype([_Letter, $:, $/|_]) -> absolute;
win32_pathtype([_Letter, $:, $\\|_]) -> absolute;
win32_pathtype([_Letter, $:|_]) -> volumerelative;
win32_pathtype(_) 		  -> relative.

%% Returns all characters in the filename, except the extension.
%%
%% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle"
%%           rootname("/jam.src/foo.erl") -> "/jam.src/foo"

rootname(Name0) ->
    Name = flatten(Name0),
    rootname(Name, [], [], major_os_type()).

rootname([$/|Rest], Root, Ext, OsType) ->
    rootname(Rest, [$/]++Ext++Root, [], OsType);
rootname([$\\|Rest], Root, Ext, win32) ->
    rootname(Rest, [$/]++Ext++Root, [], win32);
rootname([$\\|Rest], Root, Ext, vxworks) ->
    rootname(Rest, [$/]++Ext++Root, [], vxworks);
rootname([$.|Rest], Root, [], OsType) ->
    rootname(Rest, Root, ".", OsType);
rootname([$.|Rest], Root, Ext, OsType) ->
    rootname(Rest, Ext++Root, ".", OsType);
rootname([[_|_]=List|Rest], Root, Ext, OsType) ->
    rootname(List++Rest, Root, Ext, OsType);
rootname([Char|Rest], Root, [], OsType) when is_integer(Char) ->
    rootname(Rest, [Char|Root], [], OsType);
rootname([Char|Rest], Root, Ext, OsType) when is_integer(Char) ->
    rootname(Rest, Root, [Char|Ext], OsType);
rootname([], Root, _Ext, _OsType) ->
    lists:reverse(Root).

%% Returns all characters in the filename, except the given extension.
%% If the filename has another extension, the complete filename is
%% returned.
%%
%% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam"
%%           rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo"

rootname(Name0, Ext0) ->
    Name = flatten(Name0),
    Ext = flatten(Ext0),
    rootname2(Name, Ext, []).

rootname2(Ext, Ext, Result) ->
    lists:reverse(Result);
rootname2([], _Ext, Result) ->
    lists:reverse(Result);
rootname2([[_|_]=List|Rest], Ext, Result) ->
    rootname2(List++Rest, Ext, Result);
rootname2([Char|Rest], Ext, Result) when is_integer(Char) ->
    rootname2(Rest, Ext, [Char|Result]).

%% Returns a list whose elements are the path components in the filename.
%%
%% Examples:	
%% split("/usr/local/bin") -> ["/", "usr", "local", "bin"]
%% split("foo/bar") -> ["foo", "bar"]
%% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"]

split(Name0) ->
    Name = flatten(Name0),
    case os:type() of
	{unix, _}  -> unix_split(Name);
	{win32, _} -> win32_split(Name);
	vxworks -> vxworks_split(Name);
	{ose,_} -> unix_split(Name)
    end.

%% If a VxWorks filename starts with '[/\].*[^/\]' '[/\].*:' or '.*:' 
%% that part of the filename is considered a device.  
%% The rest of the name is interpreted exactly as for win32.

%% XXX - dirty solution to make filename:split([]) return the same thing on
%%       VxWorks as on unix and win32.
vxworks_split([]) ->
    [];
vxworks_split(L) -> 
    {_Devicep, Rest, FirstComp} = vxworks_first(L),
    split(Rest, [], [lists:reverse(FirstComp)], win32).

unix_split(Name) ->
    split(Name, [], unix).

win32_split([$\\|Rest]) ->
    win32_split([$/|Rest]);
win32_split([X, $\\|Rest]) when is_integer(X) ->
    win32_split([X, $/|Rest]);
win32_split([X, Y, $\\|Rest]) when is_integer(X), is_integer(Y) ->
    win32_split([X, Y, $/|Rest]);
win32_split([List|Rest]) when is_list(List) ->
    win32_split(List++Rest);
win32_split([Char, List|Rest]) when is_list(List) ->
    win32_split([Char|List++Rest]);
win32_split([$/, $/|Rest]) ->
    split(Rest, [], [[$/, $/]]);
win32_split([C1, C2, List|Rest]) when is_list(List) ->
    win32_split([C1, C2|List++Rest]);
win32_split([UcLetter, $:|Rest]) when UcLetter >= $A, UcLetter =< $Z ->
    win32_split([UcLetter+$a-$A, $:|Rest]);
win32_split([Letter, $:, $/|Rest]) ->
    split(Rest, [], [[Letter, $:, $/]], win32);
win32_split([Letter, $:|Rest]) ->
    split(Rest, [], [[Letter, $:]], win32);
win32_split(Name) ->
    split(Name, [], win32).

split([$/|Rest], Components, OsType) ->
    split(Rest, [], [[$/]|Components], OsType);
split([$\\|Rest], Components, win32) ->
    split(Rest, [], [[$/]|Components], win32);
split([List|Rest], Components, OsType) when is_list(List) ->
    split(List++Rest, Components, OsType);
split(RelativeName, Components, OsType) ->
    split(RelativeName, [], Components, OsType).

split([$\\|Rest], Comp, Components, win32) ->
    split([$/|Rest], Comp, Components, win32);
split([$/|Rest], [], Components, OsType) ->
    split(Rest, [], Components, OsType);
split([$/|Rest], Comp, Components, OsType) ->
    split(Rest, [], [lists:reverse(Comp)|Components], OsType);
split([Char|Rest], Comp, Components, OsType) when is_integer(Char) ->
    split(Rest, [Char|Comp], Components, OsType);
split([List|Rest], Comp, Components, OsType) when is_list(List) ->
    split(List++Rest, Comp, Components, OsType);
split([], [], Components, _OsType) ->
    lists:reverse(Components);
split([], Comp, Components, OsType) ->
    split([], [], [lists:reverse(Comp)|Components], OsType).

%% Converts a filename to a form accepedt by the command shell and native
%% applications on the current platform.  On Windows, forward slashes
%% will be converted to backslashes.  On all platforms, the
%% name will be normalized as done by join/1.

nativename(Name0) ->
    Name = join([Name0]),			%Normalize.
    case os:type() of
	{win32, _} -> win32_nativename(Name);
	_          -> Name
    end.

win32_nativename([$/|Rest]) ->
    [$\\|win32_nativename(Rest)];
win32_nativename([C|Rest]) ->
    [C|win32_nativename(Rest)];
win32_nativename([]) ->
    [].

separators() ->
    case os:type() of
	{unix, _}  -> {false, false};
	{win32, _} -> {$\\, $:};
	vxworks -> {$\\, false};
	{ose,_} -> {false, false}
    end.


%% find_src(Module) --
%% find_src(Module, Rules) --
%%
%% Finds the source file name and compilation options for a compiled
%% module.  The result can be fed to compile:file/2 to compile the
%% file again.
%%
%% The Module argument (which can be a string or an atom) specifies 
%% either the module name or the path to the source code, with or 
%% without the ".erl" extension.  In either case the module must be
%% known by the code manager, i.e. code:which/1 should succeed.
%%
%% Rules describes how the source directory should be found given
%% the directory for the object code.  Each rule is on the form
%% {BinSuffix, SourceSuffix}, and is interpreted like this:
%% If the end of directory name where the object is located matches
%% BinSuffix, then the suffix will be replaced with SourceSuffix
%% in the directory name.  If the source file in the resulting
%% directory, the next rule will be tried.
%%
%% Returns: {SourceFile, Options}
%%
%% SourceFile is the absolute path to the source file (but without the ".erl"
%% extension) and Options are the necessary options to compile the file
%% with compile:file/2, but doesn't include options like 'report' or
%% 'verbose' that doesn't change the way code is generated.
%% The paths in the {outdir, Path} and {i, Path} options are guaranteed
%% to be absoulute.

find_src(Mod) ->
    Default = [{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}],
    Rules = 
	case application:get_env(kernel, source_search_rules) of
	    undefined -> Default;
	    {ok, []} -> Default;
	    {ok, R} when is_list(R) -> R
	end,
    find_src(Mod, Rules).

find_src(Mod, Rules) when is_atom(Mod) ->
    find_src(atom_to_list(Mod), Rules);
find_src(File0, Rules) when is_list(File0) ->
    Mod = list_to_atom(basename(File0, ".erl")),
    File = rootname(File0, ".erl"),
    case readable_file(File++".erl") of
	true  ->
	    try_file(File, Mod, Rules);
	false ->
	    try_file(undefined, Mod, Rules)
    end.

try_file(File, Mod, Rules) ->
    case code:which(Mod) of
	Possibly_Rel_Path when is_list(Possibly_Rel_Path) ->
	    {ok, Cwd} = file:get_cwd(),
	    Path = join(Cwd, Possibly_Rel_Path),
	    try_file(File, Path, Mod, Rules);
	Ecode when is_atom(Ecode) -> % Ecode = non_existing | preloaded | interpreted
	    {error, {Ecode, Mod}}
    end.

%% At this point, the Mod is known to be valid.
%% If the source name is not known, find it.
%% Then get the compilation options.
%% Returns: {SrcFile, Options}

try_file(undefined, ObjFilename, Mod, Rules) ->
    case get_source_file(ObjFilename, Mod, Rules) of
	{ok, File} -> try_file(File, ObjFilename, Mod, Rules);
	Error -> Error
    end;
try_file(Src, _ObjFilename, Mod, _Rules) ->
    List = Mod:module_info(compile),
    {value, {options, Options}} = lists:keysearch(options, 1, List),
    {ok, Cwd} = file:get_cwd(),
    AbsPath = make_abs_path(Cwd, Src),
    {AbsPath, filter_options(dirname(AbsPath), Options, [])}.

%% Filters the options.
%%
%% 1) Remove options that have no effect on the generated code,
%%    such as report and verbose.
%%
%% 2) The paths found in {i, Path} and {outdir, Path} are converted
%%    to absolute paths.  When doing this, it is assumed that relatives
%%    paths are relative to directory where the source code is located.
%%    This is not necessarily true.  It would be safer if the compiler
%%    would emit absolute paths in the first place.

filter_options(Base, [{outdir, Path}|Rest], Result) ->
    filter_options(Base, Rest, [{outdir, make_abs_path(Base, Path)}|Result]);
filter_options(Base, [{i, Path}|Rest], Result) ->
    filter_options(Base, Rest, [{i, make_abs_path(Base, Path)}|Result]);
filter_options(Base, [Option|Rest], Result) when Option =:= trace ->
    filter_options(Base, Rest, [Option|Result]);
filter_options(Base, [Option|Rest], Result) when Option =:= export_all ->
    filter_options(Base, Rest, [Option|Result]);
filter_options(Base, [Option|Rest], Result) when Option =:= binary ->
    filter_options(Base, Rest, [Option|Result]);
filter_options(Base, [Option|Rest], Result) when Option =:= fast ->
    filter_options(Base, Rest, [Option|Result]);
filter_options(Base, [Tuple|Rest], Result) when element(1, Tuple) =:= d ->
    filter_options(Base, Rest, [Tuple|Result]);
filter_options(Base, [Tuple|Rest], Result)
when element(1, Tuple) =:= parse_transform ->
    filter_options(Base, Rest, [Tuple|Result]);
filter_options(Base, [_|Rest], Result) ->
    filter_options(Base, Rest, Result);
filter_options(_Base, [], Result) ->
    Result.

%% Gets the source file given path of object code and module name.

get_source_file(Obj, Mod, Rules) ->
    case catch Mod:module_info(source_file) of
	{'EXIT', _Reason} ->
	    source_by_rules(dirname(Obj), packages:last(Mod), Rules);
	File ->
	    {ok, File}
    end.

source_by_rules(Dir, Base, [{From, To}|Rest]) ->
    case try_rule(Dir, Base, From, To) of
	{ok, File} -> {ok, File};
	error      -> source_by_rules(Dir, Base, Rest)
    end;
source_by_rules(_Dir, _Base, []) ->
    {error, source_file_not_found}.

try_rule(Dir, Base, From, To) ->
    case lists:suffix(From, Dir) of
	true -> 
	    NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To,
	    Src = join(NewDir, Base),
	    case readable_file(Src++".erl") of
		true -> {ok, Src};
		false -> error
	    end;
	false ->
	    error
    end.

readable_file(File) ->
    case file:read_file_info(File) of
	{ok, #file_info{type=regular, access=read}} ->
	    true;
	{ok, #file_info{type=regular, access=read_write}} ->
	    true;
	_Other ->
	    false
    end.

make_abs_path(BasePath, Path) ->
    join(BasePath, Path).

major_os_type() ->
    case os:type() of
	{OsT, _} -> OsT;
	OsT -> OsT
    end.

%% Need to take care of the first pathname component separately
%% due to VxWorks less than good device naming rules.
%% (i.e. this is VxWorks specific ...)
%% The following four all starts with device names
%% elrond:/foo -> elrond:
%% elrond:\\foo.bar -> elrond:
%% /DISK1:foo -> /DISK1:
%% /usr/include -> /usr
%% This one doesn't:
%% foo/bar

vxworks_first([]) ->
    {not_device, [], []};
vxworks_first([$/|T]) ->
    vxworks_first2(device, T, [$/]);
vxworks_first([$\\|T]) ->
    vxworks_first2(device, T, [$/]);
vxworks_first([H|T]) when is_list(H) ->
    vxworks_first(H++T);
vxworks_first([H|T]) ->
    vxworks_first2(not_device, T, [H]).

vxworks_first2(Devicep, [], FirstComp) ->
    {Devicep, [], FirstComp};
vxworks_first2(Devicep, [$/|T], FirstComp) ->
    {Devicep, [$/|T], FirstComp};
vxworks_first2(Devicep, [$\\|T], FirstComp) ->
    {Devicep, [$/|T], FirstComp};
vxworks_first2(_Devicep, [$:|T], FirstComp)->
    {device, T, [$:|FirstComp]};
vxworks_first2(Devicep, [H|T], FirstComp) when is_list(H) ->
    vxworks_first2(Devicep, H++T, FirstComp);
vxworks_first2(Devicep, [H|T], FirstComp) ->
    vxworks_first2(Devicep, T, [H|FirstComp]).
    
%% flatten(List)
%%  Flatten a list, also accepting atoms.

flatten(List) ->
    do_flatten(List, []).

do_flatten([H|T], Tail) when is_list(H) ->
    do_flatten(H, do_flatten(T, Tail));
do_flatten([H|T], Tail) when is_atom(H) ->
    atom_to_list(H) ++ do_flatten(T, Tail);
do_flatten([H|T], Tail) ->
    [H|do_flatten(T, Tail)];
do_flatten([], Tail) ->
    Tail;
do_flatten(Atom, Tail) when is_atom(Atom) ->
    atom_to_list(Atom) ++ flatten(Tail).