diff options
Diffstat (limited to 'lib/stdlib/src/filename.erl')
| -rw-r--r-- | lib/stdlib/src/filename.erl | 787 |
1 files changed, 787 insertions, 0 deletions
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl new file mode 100644 index 0000000000..cd26b2e219 --- /dev/null +++ b/lib/stdlib/src/filename.erl @@ -0,0 +1,787 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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(filename). + +%% Purpose: Provides generic manipulation of filenames. +%% +%% Generally, these functions accept filenames in the native format +%% for the current operating system (Unix or Windows). +%% Deep characters lists (as returned by io_lib:format()) are accepted; +%% resulting strings will always be flat. +%% +%% Implementation note: We used to only flatten if the list turned out +%% to be deep. Now that atoms are allowed in deep lists, in most cases +%% we flatten the arguments immediately on function entry as that makes +%% it easier to ensure that the code works. + +-export([absname/1, absname/2, absname_join/2, + basename/1, basename/2, dirname/1, + extension/1, join/1, join/2, pathtype/1, + rootname/1, rootname/2, split/1, nativename/1]). +-export([find_src/1, find_src/2, flatten/1]). + +%% Undocumented and unsupported exports. +-export([append/2]). + +-include_lib("kernel/include/file.hrl"). + +%% Converts a relative filename to an absolute filename +%% or the filename itself if it already is an absolute filename +%% Note that no attempt is made to create the most beatiful +%% absolute name since this can give incorrect results on +%% file systems which allows links. +%% Examples: +%% Assume (for UNIX) current directory "/usr/local" +%% Assume (for WIN32) current directory "D:/usr/local" +%% +%% (for Unix) : absname("foo") -> "/usr/local/foo" +%% (for WIN32): absname("foo") -> "D:/usr/local/foo" +%% (for Unix) : absname("../x") -> "/usr/local/../x" +%% (for WIN32): absname("../x") -> "D:/usr/local/../x" +%% (for Unix) : absname("/") -> "/" +%% (for WIN32): absname("/") -> "D:/" + +-spec absname(name()) -> string(). +absname(Name) -> + {ok, Cwd} = file:get_cwd(), + absname(Name, Cwd). + +-spec absname(name(), string()) -> string(). +absname(Name, AbsBase) -> + case pathtype(Name) of + relative -> + absname_join(AbsBase, Name); + absolute -> + %% We must flatten the filename before passing it into join/1, + %% or we will get slashes inserted into the wrong places. + join([flatten(Name)]); + volumerelative -> + absname_vr(split(Name), split(AbsBase), AbsBase) + end. + +%% Handles volumerelative names (on Windows only). + +absname_vr(["/"|Rest1], [Volume|_], _AbsBase) -> + %% Absolute path on current drive. + join([Volume|Rest1]); +absname_vr([[X, $:]|Rest1], [[X|_]|_], AbsBase) -> + %% Relative to current directory on current drive. + absname(join(Rest1), AbsBase); +absname_vr([[X, $:]|Name], _, _AbsBase) -> + %% Relative to current directory on another drive. + Dcwd = + case file:get_cwd([X, $:]) of + {ok, Dir} -> Dir; + {error, _} -> [X, $:, $/] + end, + absname(join(Name), Dcwd). + +%% Joins a relative filename to an absolute base. For VxWorks the +%% resulting name is fixed to minimize the length by collapsing +%% ".." directories. +%% For other systems this is just a join/2, but assumes that +%% AbsBase must be absolute and Name must be relative. + +-spec absname_join(string(), name()) -> string(). +absname_join(AbsBase, Name) -> + case major_os_type() of + vxworks -> + absname_pretty(AbsBase, split(Name), lists:reverse(split(AbsBase))); + _Else -> + join(AbsBase, flatten(Name)) + end. + +%% Handles absolute filenames for VxWorks - these are 'pretty-printed', +%% since a C function call chdir("/erlang/lib/../bin") really sets +%% cwd to '/erlang/lib/../bin' which also works, but the long term +%% effect is potentially not so good ... +%% +%% absname_pretty("../bin", "/erlang/lib") -> "/erlang/bin" +%% absname_pretty("../../../..", "/erlang") -> "/erlang" + +absname_pretty(Abspath, Relpath, []) -> + %% AbsBase _must_ begin with a vxworks device name + {device, _Rest, Dev} = vxworks_first(Abspath), + absname_pretty(Abspath, Relpath, [lists:reverse(Dev)]); +absname_pretty(_Abspath, [], AbsBase) -> + join(lists:reverse(AbsBase)); +absname_pretty(Abspath, [[$.]|Rest], AbsBase) -> + absname_pretty(Abspath, Rest, AbsBase); +absname_pretty(Abspath, [[$.,$.]|Rest], [_|AbsRest]) -> + absname_pretty(Abspath, Rest, AbsRest); +absname_pretty(Abspath, [First|Rest], AbsBase) -> + absname_pretty(Abspath, Rest, [First|AbsBase]). + +%% Returns the part of the filename after the last directory separator, +%% or the filename itself if it has no separators. +%% +%% Examples: basename("foo") -> "foo" +%% basename("/usr/foo") -> "foo" +%% basename("/usr/foo/") -> "foo" (trailing slashes ignored) +%% basename("/") -> [] + +-spec basename(name()) -> string(). +basename(Name0) -> + Name = flatten(Name0), + {DirSep2, DrvSep} = separators(), + basename1(skip_prefix(Name, DrvSep), [], DirSep2). + +basename1([$/|[]], Tail, DirSep2) -> + basename1([], Tail, DirSep2); +basename1([$/|Rest], _Tail, DirSep2) -> + basename1(Rest, [], DirSep2); +basename1([[_|_]=List|Rest], Tail, DirSep2) -> + basename1(List++Rest, Tail, DirSep2); +basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> + basename1([$/|Rest], Tail, DirSep2); +basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> + basename1(Rest, [Char|Tail], DirSep2); +basename1([], Tail, _DirSep2) -> + lists:reverse(Tail). + +skip_prefix(Name, false) -> % No prefix for unix, but for VxWorks. + case major_os_type() of + vxworks -> + case vxworks_first(Name) of + {device, Rest, _Device} -> + Rest; + {not_device, _Rest, _First} -> + Name + end; + _Else -> + Name + end; +skip_prefix(Name, DrvSep) -> + skip_prefix1(Name, DrvSep). + +skip_prefix1([L, DrvSep|Name], DrvSep) when is_integer(L) -> + Name; +skip_prefix1([L], _) when is_integer(L) -> + [L]; +skip_prefix1(Name, _) -> + Name. + +%% Returns the last component of the filename, with the given +%% extension stripped. Use this function if you want +%% to remove an extension that might or might not be there. +%% Use rootname(basename(File)) if you want to remove an extension +%% that you know exists, but you are not sure which one it is. +%% +%% Example: basename("~/src/kalle.erl", ".erl") -> "kalle" +%% basename("~/src/kalle.jam", ".erl") -> "kalle.jam" +%% basename("~/src/kalle.old.erl", ".erl") -> "kalle.old" +%% +%% rootname(basename("xxx.jam")) -> "xxx" +%% rootname(basename("xxx.erl")) -> "xxx" + +-spec basename(name(), name()) -> string(). +basename(Name0, Ext0) -> + Name = flatten(Name0), + Ext = flatten(Ext0), + {DirSep2,DrvSep} = separators(), + NoPrefix = skip_prefix(Name, DrvSep), + basename(NoPrefix, Ext, [], DirSep2). + +basename(Ext, Ext, Tail, _DrvSep2) -> + lists:reverse(Tail); +basename([$/|[]], Ext, Tail, DrvSep2) -> + basename([], Ext, Tail, DrvSep2); +basename([$/|Rest], Ext, _Tail, DrvSep2) -> + basename(Rest, Ext, [], DrvSep2); +basename([$\\|Rest], Ext, Tail, DirSep2) when is_integer(DirSep2) -> + basename([$/|Rest], Ext, Tail, DirSep2); +basename([Char|Rest], Ext, Tail, DrvSep2) when is_integer(Char) -> + basename(Rest, Ext, [Char|Tail], DrvSep2); +basename([], _Ext, Tail, _DrvSep2) -> + lists:reverse(Tail). + +%% Returns the directory part of a pathname. +%% +%% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", +%% dirname("kalle.erl") -> "." + +-spec dirname(name()) -> string(). +dirname(Name0) -> + Name = flatten(Name0), + case os:type() of + vxworks -> + {Devicep, Restname, FirstComp} = vxworks_first(Name), + case Devicep of + device -> + dirname(Restname, FirstComp, [], separators()); + _ -> + dirname(Name, [], [], separators()) + end; + _ -> + dirname(Name, [], [], separators()) + end. + +dirname([[_|_]=List|Rest], Dir, File, Seps) -> + dirname(List++Rest, Dir, File, Seps); +dirname([$/|Rest], Dir, File, Seps) -> + dirname(Rest, File++Dir, [$/], Seps); +dirname([DirSep|Rest], Dir, File, {DirSep,_}=Seps) when is_integer(DirSep) -> + dirname(Rest, File++Dir, [$/], Seps); +dirname([Dl,DrvSep|Rest], [], [], {_,DrvSep}=Seps) + when is_integer(DrvSep), ((($a =< Dl) and (Dl =< $z)) or + (($A =< Dl) and (Dl =< $Z))) -> + dirname(Rest, [DrvSep,Dl], [], Seps); +dirname([Char|Rest], Dir, File, Seps) when is_integer(Char) -> + dirname(Rest, Dir, [Char|File], Seps); +dirname([], [], File, _Seps) -> + case lists:reverse(File) of + [$/|_] -> [$/]; + _ -> "." + end; +dirname([], [$/|Rest], File, Seps) -> + dirname([], Rest, File, Seps); +dirname([], [DrvSep,Dl], File, {_,DrvSep}) -> + case lists:reverse(File) of + [$/|_] -> [Dl,DrvSep,$/]; + _ -> [Dl,DrvSep] + end; +dirname([], Dir, _, _) -> + lists:reverse(Dir). + +%% Given a filename string, returns the file extension, +%% including the period. Returns an empty list if there +%% is no extension. +%% +%% Example: extension("foo.erl") -> ".erl" +%% extension("jam.src/kalle") -> "" +%% +%% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" + +-spec extension(name()) -> string(). +extension(Name0) -> + Name = flatten(Name0), + extension(Name, [], major_os_type()). + +extension([$.|Rest], _Result, OsType) -> + extension(Rest, [$.], OsType); +extension([Char|Rest], [], OsType) when is_integer(Char) -> + extension(Rest, [], OsType); +extension([$/|Rest], _Result, OsType) -> + extension(Rest, [], OsType); +extension([$\\|Rest], _Result, win32) -> + extension(Rest, [], win32); +extension([$\\|Rest], _Result, vxworks) -> + extension(Rest, [], vxworks); +extension([Char|Rest], Result, OsType) when is_integer(Char) -> + extension(Rest, [Char|Result], OsType); +extension([], Result, _OsType) -> + lists:reverse(Result). + +%% Joins a list of filenames with directory separators. + +-spec join([string()]) -> string(). +join([Name1, Name2|Rest]) -> + join([join(Name1, Name2)|Rest]); +join([Name]) when is_list(Name) -> + join1(Name, [], [], major_os_type()); +join([Name]) when is_atom(Name) -> + join([atom_to_list(Name)]). + +%% Joins two filenames with directory separators. + +-spec join(string(), string()) -> string(). +join(Name1, Name2) when is_list(Name1), is_list(Name2) -> + OsType = major_os_type(), + case pathtype(Name2) of + relative -> join1(Name1, Name2, [], OsType); + _Other -> join1(Name2, [], [], OsType) + end; +join(Name1, Name2) when is_atom(Name1) -> + join(atom_to_list(Name1), Name2); +join(Name1, Name2) when is_atom(Name2) -> + join(Name1, atom_to_list(Name2)). + +%% Internal function to join an absolute name and a relative name. +%% It is the responsibility of the caller to ensure that RelativeName +%% is relative. + +join1([UcLetter, $:|Rest], RelativeName, [], win32) +when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z -> + join1(Rest, RelativeName, [$:, UcLetter+$a-$A], win32); +join1([$\\|Rest], RelativeName, Result, win32) -> + join1([$/|Rest], RelativeName, Result, win32); +join1([$\\|Rest], RelativeName, Result, vxworks) -> + join1([$/|Rest], RelativeName, Result, vxworks); +join1([$/|Rest], RelativeName, [$., $/|Result], OsType) -> + join1(Rest, RelativeName, [$/|Result], OsType); +join1([$/|Rest], RelativeName, [$/|Result], OsType) -> + join1(Rest, RelativeName, [$/|Result], OsType); +join1([], [], Result, OsType) -> + maybe_remove_dirsep(Result, OsType); +join1([], RelativeName, [$:|Rest], win32) -> + join1(RelativeName, [], [$:|Rest], win32); +join1([], RelativeName, [$/|Result], OsType) -> + join1(RelativeName, [], [$/|Result], OsType); +join1([], RelativeName, Result, OsType) -> + join1(RelativeName, [], [$/|Result], OsType); +join1([[_|_]=List|Rest], RelativeName, Result, OsType) -> + join1(List++Rest, RelativeName, Result, OsType); +join1([[]|Rest], RelativeName, Result, OsType) -> + join1(Rest, RelativeName, Result, OsType); +join1([Char|Rest], RelativeName, Result, OsType) when is_integer(Char) -> + join1(Rest, RelativeName, [Char|Result], OsType); +join1([Atom|Rest], RelativeName, Result, OsType) when is_atom(Atom) -> + join1(atom_to_list(Atom)++Rest, RelativeName, Result, OsType). + +maybe_remove_dirsep([$/, $:, Letter], win32) -> + [Letter, $:, $/]; +maybe_remove_dirsep([$/], _) -> + [$/]; +maybe_remove_dirsep([$/|Name], _) -> + lists:reverse(Name); +maybe_remove_dirsep(Name, _) -> + lists:reverse(Name). + +%% Appends a directory separator and a pathname component to +%% a given base directory, which is is assumed to be normalised +%% by a previous call to join/{1,2}. + +-spec append(string(), name()) -> string(). +append(Dir, Name) -> + Dir ++ [$/|Name]. + +%% Returns one of absolute, relative or volumerelative. +%% +%% absolute The pathname refers to a specific file on a specific +%% volume. Example: /usr/local/bin/ (on Unix), +%% h:/port_test (on Windows). +%% relative The pathname is relative to the current working directory +%% on the current volume. Example: foo/bar, ../src +%% volumerelative The pathname is relative to the current working directory +%% on the specified volume, or is a specific file on the +%% current working volume. (Windows only) +%% Example: a:bar.erl, /temp/foo.erl + +-spec pathtype(name()) -> 'absolute' | 'relative' | 'volumerelative'. +pathtype(Atom) when is_atom(Atom) -> + pathtype(atom_to_list(Atom)); +pathtype(Name) when is_list(Name) -> + case os:type() of + {unix, _} -> unix_pathtype(Name); + {win32, _} -> win32_pathtype(Name); + vxworks -> case vxworks_first(Name) of + {device, _Rest, _Dev} -> + absolute; + _ -> + relative + end; + {ose,_} -> unix_pathtype(Name) + end. + +unix_pathtype([$/|_]) -> + absolute; +unix_pathtype([List|Rest]) when is_list(List) -> + unix_pathtype(List++Rest); +unix_pathtype([Atom|Rest]) when is_atom(Atom) -> + unix_pathtype(atom_to_list(Atom)++Rest); +unix_pathtype(_) -> + 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" + +-spec rootname(name()) -> string(). +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([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" + +-spec rootname(name(), name()) -> string(). +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([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"] + +-spec split(name()) -> [string()]. +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([$/, $/|Rest]) -> + split(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(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. + +-spec nativename(string()) -> string(). +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 absolute. + +-type rule() :: {string(), string()}. +-type ecode() :: 'non_existing' | 'preloaded' | 'interpreted'. +-type option() :: {'i', string()} | {'outdir', string()} | {'d', atom()}. + +-spec find_src(atom() | string()) -> + {string(), [option()]} | {'error', {ecode(), atom()}}. +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). + +-spec find_src(atom() | string(), [rule()]) -> + {string(), [option()]} | {'error', {ecode(), atom()}}. +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 :: ecode() + {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), + {options, Options} = lists:keyfind(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. + +-spec flatten(name()) -> string(). +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). |