filename.erl

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

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-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:/"

absname(Name) ->
    {ok, Cwd} = file:get_cwd(),
    absname(Name, Cwd).

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.

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("/") -> []

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"


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") -> "."

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"

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([List|Rest], Result, OsType) when is_list(List) ->
    extension(List++Rest, Result, OsType);
extension([], Result, _OsType) ->
    lists:reverse(Result).

%% Joins a list of filenames with directory separators.

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.

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 an pathname component to
%% a given base directory, which is is assumed to be normalised
%% by a previous call to join/{1,2}.

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
%% volumerleative  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

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(_) ->