aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/beam/atom.names1
-rw-r--r--erts/emulator/beam/bif.tab4
-rw-r--r--erts/emulator/beam/erl_init.c22
-rw-r--r--erts/emulator/beam/erl_unicode.c108
-rw-r--r--erts/emulator/beam/sys.h3
-rw-r--r--erts/emulator/sys/common/erl_sys_common_misc.c52
-rw-r--r--lib/kernel/src/file.erl4
-rw-r--r--lib/stdlib/src/filename.erl335
8 files changed, 345 insertions, 184 deletions
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 93b8e3ec28..327620772f 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -549,7 +549,6 @@ atom waiting
atom wall_clock
atom warning
atom warning_msg
-atom win_wchar
atom wordsize
atom write_concurrency
atom xor
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 55166417e5..cf251d9016 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -797,8 +797,8 @@ bif erlang:nif_error/2
#
# Helpers for unicode filenames
#
-bif file:name2native/1
-bif file:native2name/1
+bif file:internal_name2native/1
+bif file:internal_native2name/1
bif file:native_name_encoding/0
#
# Obsolete
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index a7892e143b..464ee750f7 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -908,7 +908,27 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM,
("using display items %d\n",display_items));
break;
-
+ case 'f':
+ if (!strncmp(argv[i],"-fn",3)) {
+ arg = get_arg(argv[i]+3, argv[i+1], &i);
+ switch (*arg) {
+ case 'u':
+ erts_set_user_requested_filename_encoding(ERL_FILENAME_UTF8);
+ break;
+ case 'l':
+ erts_set_user_requested_filename_encoding(ERL_FILENAME_LATIN1);
+ break;
+ case 'a':
+ erts_set_user_requested_filename_encoding(ERL_FILENAME_UNKNOWN);
+ default:
+ erts_fprintf(stderr, "bad filename encoding %s, can be (l,u or a)\n", arg);
+ erts_usage();
+ }
+ break;
+ } else {
+ erts_fprintf(stderr, "%s unknown flag %s\n", argv[0], argv[i]);
+ erts_usage();
+ }
case 'l':
display_loads++;
break;
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 671c3c0cdf..3e7a935cef 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -1876,6 +1876,10 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
Uint x = unsigned_val(obj);
switch (encoding) {
case ERL_FILENAME_LATIN1:
+ if (x > 255) {
+ DESTROY_ESTACK(stack);
+ return ((Sint) -1);
+ }
need += 1;
break;
case ERL_FILENAME_UTF8:
@@ -2101,12 +2105,76 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
-BIF_RETTYPE file_name2native_1(BIF_ALIST_1)
+BIF_RETTYPE file_internal_name2native_1(BIF_ALIST_1)
{
int encoding = erts_get_native_filename_encoding();
Sint need;
Eterm bin_term;
byte* bin_p;
+ if (is_binary(BIF_ARG_1)) {
+ byte *temp_alloc = NULL;
+ byte *bytes;
+ byte *err_pos;
+ Uint size,num_chars;
+ Uint unipoint;
+ /* Uninterpreted encoding except if windows widechar, in case we convert from
+ utf8 to win_wchar */
+ if (encoding != ERL_FILENAME_WIN_WCHAR) {
+ BIF_RET(BIF_ARG_1);
+ }
+ /* In a wchar world, the emulator flags only affect how
+ binaries are interpreted when sent from the user. */
+ /* Determine real length and create a new binary */
+ size = binary_size(BIF_ARG_1);
+ bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc);
+ if (analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != UTF8_OK ||
+ erts_get_user_requested_filename_encoding() == ERL_FILENAME_LATIN1) {
+ /* What to do now? Maybe latin1, so just take byte for byte instead */
+ bin_term = new_binary(BIF_P, 0, size*2);
+ bin_p = binary_bytes(bin_term);
+ while (size--) {
+ *bin_p++ = *bytes++;
+ *bin_p++ = 0;
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_RET(bin_term);
+ }
+ /* OK, UTF8 ok, number of characters is in num_chars */
+ bin_term = new_binary(BIF_P, 0, num_chars*2);
+ bin_p = binary_bytes(bin_term);
+ while (num_chars--) {
+ if (((*bytes) & ((byte) 0x80)) == 0) {
+ unipoint = (Uint) *bytes;
+ ++bytes;
+ } else if (((*bytes) & ((byte) 0xE0)) == 0xC0) {
+ unipoint =
+ (((Uint) ((*bytes) & ((byte) 0x1F))) << 6) |
+ ((Uint) (bytes[1] & ((byte) 0x3F)));
+ bytes += 2;
+ } else if (((*bytes) & ((byte) 0xF0)) == 0xE0) {
+ unipoint =
+ (((Uint) ((*bytes) & ((byte) 0xF))) << 12) |
+ (((Uint) (bytes[1] & ((byte) 0x3F))) << 6) |
+ ((Uint) (bytes[2] & ((byte) 0x3F)));
+ bytes +=3;
+ } else if (((*bytes) & ((byte) 0xF8)) == 0xF0) {
+ unipoint =
+ (((Uint) ((*bytes) & ((byte) 0x7))) << 18) |
+ (((Uint) (bytes[1] & ((byte) 0x3F))) << 12) |
+ (((Uint) (bytes[2] & ((byte) 0x3F))) << 6) |
+ ((Uint) (bytes[3] & ((byte) 0x3F)));
+ bytes += 4;
+ } else {
+ erl_exit(1,"Internal unicode error in file:name2native/1");
+ }
+ *bin_p++ = (byte) (unipoint & 0xFF);
+ *bin_p++ = (byte) ((unipoint >> 8) & 0xFF);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_RET(bin_term);
+ } /* binary */
+
+
if ((need = simple_char_need(BIF_ARG_1,encoding)) < 0) {
BIF_ERROR(BIF_P,BADARG);
}
@@ -2116,7 +2184,7 @@ BIF_RETTYPE file_name2native_1(BIF_ALIST_1)
BIF_RET(bin_term);
}
-BIF_RETTYPE file_native2name_1(BIF_ALIST_1)
+BIF_RETTYPE file_internal_native2name_1(BIF_ALIST_1)
{
Eterm real_bin;
Uint offset;
@@ -2144,12 +2212,15 @@ BIF_RETTYPE file_native2name_1(BIF_ALIST_1)
}
switch (erts_get_native_filename_encoding()) {
case ERL_FILENAME_LATIN1:
- goto simple;
+ hp = HAlloc(BIF_P, 2 * size);
+ bytes = binary_bytes(real_bin)+offset;
+
+ BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes, size, bitoffs));
case ERL_FILENAME_UTF8:
bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc);
if (analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != UTF8_OK) {
erts_free_aligned_binary_bytes(temp_alloc);
- goto simple;
+ goto noconvert;
}
num_built = 0;
num_eaten = 0;
@@ -2157,12 +2228,16 @@ BIF_RETTYPE file_native2name_1(BIF_ALIST_1)
erts_free_aligned_binary_bytes(temp_alloc);
BIF_RET(ret);
case ERL_FILENAME_WIN_WCHAR:
- if ((size % 2) != 0) {
- goto simple;
- }
bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc);
- hp = HAlloc(BIF_P, size);
- ret = NIL;
+ if ((size % 2) != 0) { /* Panic fixup to avoid crashing the emulator */
+ size--;
+ hp = HAlloc(BIF_P, size+2);
+ ret = CONS(hp,make_small((Uint) bytes[size]),NIL);
+ hp += 2;
+ } else {
+ hp = HAlloc(BIF_P, size);
+ ret = NIL;
+ }
bytes += size-1;
while (size > 0) {
Uint x = ((Uint) *bytes--) << 8;
@@ -2173,13 +2248,10 @@ BIF_RETTYPE file_native2name_1(BIF_ALIST_1)
erts_free_aligned_binary_bytes(temp_alloc);
BIF_RET(ret);
default:
- goto simple;
+ goto noconvert;
}
- simple:
- hp = HAlloc(BIF_P, 2 * size);
- bytes = binary_bytes(real_bin)+offset;
-
- BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes, size, bitoffs));
+ noconvert:
+ BIF_RET(BIF_ARG_1);
}
BIF_RETTYPE file_native_name_encoding_0(BIF_ALIST_0)
@@ -2190,7 +2262,11 @@ BIF_RETTYPE file_native_name_encoding_0(BIF_ALIST_0)
case ERL_FILENAME_UTF8:
BIF_RET(am_utf8);
case ERL_FILENAME_WIN_WCHAR:
- BIF_RET(am_win_wchar);
+ if (erts_get_user_requested_filename_encoding() == ERL_FILENAME_LATIN1) {
+ BIF_RET(am_latin1);
+ } else {
+ BIF_RET(am_utf8);
+ }
default:
BIF_RET(am_undefined);
}
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index d14e0ac105..57f2b2f16c 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -1263,6 +1263,9 @@ char* win32_errorstr(int);
#define ERL_FILENAME_WIN_WCHAR 3
int erts_get_native_filename_encoding(void);
+/* The set function is only to be used by erl_init! */
+void erts_set_user_requested_filename_encoding(int encoding);
+int erts_get_user_requested_filename_encoding(void);
void erts_init_sys_common_misc(void);
diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index dbb59676c8..581c14b6c6 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -42,33 +42,51 @@
/* Written once and only once */
static int filename_encoding = ERL_FILENAME_UNKNOWN;
+#if defined(__WIN32__)
+static int user_filename_encoding = ERL_FILENAME_UTF8; /* Default unicode on windows */
+#else
+static int user_filename_encoding = ERL_FILENAME_LATIN1;
+#endif
+void erts_set_user_requested_filename_encoding(int encoding)
+{
+ user_filename_encoding = encoding;
+}
+
+int erts_get_user_requested_filename_encoding(void)
+{
+ return user_filename_encoding;
+}
void erts_init_sys_common_misc(void)
{
#if defined(__WIN32__)
filename_encoding = ERL_FILENAME_WIN_WCHAR;
#else
- char *l;
- filename_encoding = ERL_FILENAME_LATIN1;
+ if (user_filename_encoding != ERL_FILENAME_UNKNOWN) {
+ filename_encoding = user_filename_encoding;
+ } else {
+ char *l;
+ filename_encoding = ERL_FILENAME_LATIN1;
# ifdef PRIMITIVE_UTF8_CHECK
- setlocale(LC_CTYPE, ""); /* Set international environment,
- ignore result */
- if (((l = getenv("LC_ALL")) && *l) ||
- ((l = getenv("LC_CTYPE")) && *l) ||
- ((l = getenv("LANG")) && *l)) {
- if (strstr(l, "UTF-8")) {
- filename_encoding = ERL_FILENAME_UTF8;
- }
- }
-
+ setlocale(LC_CTYPE, ""); /* Set international environment,
+ ignore result */
+ if (((l = getenv("LC_ALL")) && *l) ||
+ ((l = getenv("LC_CTYPE")) && *l) ||
+ ((l = getenv("LANG")) && *l)) {
+ if (strstr(l, "UTF-8")) {
+ filename_encoding = ERL_FILENAME_UTF8;
+ }
+ }
+
# else
- l = setlocale(LC_CTYPE, ""); /* Set international environment */
- if (l != NULL) {
- if (strcmp(nl_langinfo(CODESET), "UTF-8") == 0) {
- filename_encoding = ERL_FILENAME_UTF8;
+ l = setlocale(LC_CTYPE, ""); /* Set international environment */
+ if (l != NULL) {
+ if (strcmp(nl_langinfo(CODESET), "UTF-8") == 0) {
+ filename_encoding = ERL_FILENAME_UTF8;
+ }
}
- }
# endif
+ }
#endif
}
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 97d914b043..89432869e9 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -75,7 +75,7 @@
-define(RAM_FILE, ram_file). % Module
%% data types
--type filename() :: string().
+-type filename() :: string() | binary().
-type file_info() :: #file_info{}.
-type fd() :: #file_descriptor{}.
-type io_device() :: pid() | fd().
@@ -87,7 +87,7 @@
| 'delayed_write' | {'read_ahead', pos_integer()}
| 'read_ahead' | 'compressed'
| {'encoding', unicode:encoding()}.
--type name() :: string() | atom() | [name()].
+-type name() :: string() | atom() | [name()] | binary().
-type posix() :: 'eacces' | 'eagain' | 'ebadf' | 'ebusy' | 'edquot'
| 'eexist' | 'efault' | 'efbig' | 'eintr' | 'einval'
| 'eio' | 'eisdir' | 'eloop' | 'emfile' | 'emlink'
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index 01c06e4596..40df54fe54 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -41,6 +41,9 @@
-include_lib("kernel/include/file.hrl").
+-define(IS_DRIVELETTER(Letter),(((Letter >= $A) andalso (Letter =< $Z)) orelse
+ ((Letter >= $a) andalso (Letter =< $z)))).
+
%% 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
@@ -57,12 +60,18 @@
%% (for Unix) : absname("/") -> "/"
%% (for WIN32): absname("/") -> "D:/"
--spec absname(file:name()) -> string().
+
+-spec absname(file:name()) -> file:filename().
absname(Name) ->
{ok, Cwd} = file:get_cwd(),
absname(Name, Cwd).
--spec absname(file:name(), string()) -> string().
+-spec absname(file:name(), file:filename()) -> file:filename().
+absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) ->
+ absname(Name,filename_string_to_binary(AbsBase));
+absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) ->
+ absname(filename_string_to_binary(Name),AbsBase);
+
absname(Name, AbsBase) ->
case pathtype(Name) of
relative ->
@@ -77,6 +86,20 @@ absname(Name, AbsBase) ->
%% Handles volumerelative names (on Windows only).
+absname_vr([<<"/">>|Rest1], [Volume|_], _AbsBase) ->
+ %% Absolute path on current drive.
+ join([Volume|Rest1]);
+absname_vr([<<X, $:>>|Rest1], [<<X,_/binary>>|_], 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} -> filename_string_to_binary(Dir);
+ {error, _} -> <<X, $:, $/>>
+ end,
+ absname(join(Name), Dcwd);
absname_vr(["/"|Rest1], [Volume|_], _AbsBase) ->
%% Absolute path on current drive.
join([Volume|Rest1]);
@@ -92,41 +115,13 @@ absname_vr([[X, $:]|Name], _, _AbsBase) ->
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
+%% Joins a relative filename to an absolute base.
+%% This is just a join/2, but assumes that
%% AbsBase must be absolute and Name must be relative.
--spec absname_join(string(), file:name()) -> string().
+-spec absname_join(file:filename(), file:name()) -> file:filename().
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]).
+ join(AbsBase, flatten(Name)).
%% Returns the part of the filename after the last directory separator,
%% or the filename itself if it has no separators.
@@ -136,12 +131,36 @@ absname_pretty(Abspath, [First|Rest], AbsBase) ->
%% basename("/usr/foo/") -> "foo" (trailing slashes ignored)
%% basename("/") -> []
--spec basename(file:name()) -> string().
+-spec basename(file:name()) -> file:filename().
+basename(Name) when is_binary(Name) ->
+ case os:type() of
+ {win32,_} ->
+ win_basenameb(Name);
+ _ ->
+ basenameb(Name,[<<"/">>])
+ end;
+
basename(Name0) ->
Name = flatten(Name0),
{DirSep2, DrvSep} = separators(),
basename1(skip_prefix(Name, DrvSep), [], DirSep2).
+win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) ->
+ basenameb(Rest,[<<"/">>,<<"\\">>]);
+win_basenameb(O) ->
+ basenameb(O,[<<"/">>,<<"\\">>]).
+basenameb(Bin,Sep) ->
+ Parts = [ X || X <- binary:split(Bin,Sep,[global]),
+ X =:= <<>> ],
+ if
+ Parts =:= [] ->
+ [];
+ true ->
+ lists:last(Parts)
+ end.
+
+
+
basename1([$/|[]], Tail, DirSep2) ->
basename1([], Tail, DirSep2);
basename1([$/|Rest], _Tail, DirSep2) ->
@@ -155,26 +174,11 @@ basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) ->
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) ->
+skip_prefix(Name, false) ->
+ Name;
+skip_prefix([L, DrvSep|Name], DrvSep) when ?IS_DRIVELETTER(L) ->
Name;
-skip_prefix1([L], _) when is_integer(L) ->
- [L];
-skip_prefix1(Name, _) ->
+skip_prefix(Name, _) ->
Name.
%% Returns the last component of the filename, with the given
@@ -190,7 +194,27 @@ skip_prefix1(Name, _) ->
%% rootname(basename("xxx.jam")) -> "xxx"
%% rootname(basename("xxx.erl")) -> "xxx"
--spec basename(file:name(), file:name()) -> string().
+-spec basename(file:name(), file:name()) -> file:filename().
+basename(Name, Ext) when is_binary(Name), is_list(Ext) ->
+ basename(Name,filename_string_to_binary(Ext));
+basename(Name, Ext) when is_list(Name), is_binary(Ext) ->
+ basename(filename_string_to_binary(Name),Ext);
+basename(Name, Ext) when is_binary(Name), is_binary(Ext) ->
+ BName = basename(Name),
+ LN = byte_size(BName),
+ LE = byte_size(Ext),
+ case LN - LE of
+ Neg when Neg < 0 ->
+ BName;
+ Pos ->
+ case BName of
+ <<Part:Pos/binary,Ext/binary>> ->
+ Part;
+ Other ->
+ Other
+ end
+ end;
+
basename(Name0, Ext0) ->
Name = flatten(Name0),
Ext = flatten(Ext0),
@@ -216,21 +240,10 @@ basename([], _Ext, Tail, _DrvSep2) ->
%% Example: dirname("/usr/src/kalle.erl") -> "/usr/src",
%% dirname("kalle.erl") -> "."
--spec dirname(file:name()) -> string().
+-spec dirname(file:name()) -> file:filename().
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(Name, [], [], separators()).
dirname([[_|_]=List|Rest], Dir, File, Seps) ->
dirname(List++Rest, Dir, File, Seps);
@@ -268,7 +281,7 @@ dirname([], Dir, _, _) ->
%%
%% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src"
--spec extension(file:name()) -> string().
+-spec extension(file:name()) -> file:filename().
extension(Name0) ->
Name = flatten(Name0),
extension(Name, [], major_os_type()).
@@ -281,8 +294,6 @@ 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) ->
@@ -290,23 +301,36 @@ extension([], Result, _OsType) ->
%% Joins a list of filenames with directory separators.
--spec join([string()]) -> string().
+-spec join([file:filename()]) -> file:filename().
join([Name1, Name2|Rest]) ->
join([join(Name1, Name2)|Rest]);
join([Name]) when is_list(Name) ->
join1(Name, [], [], major_os_type());
+join([Name]) when is_binary(Name) ->
+ join1b(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().
+-spec join(file:filename(), file:filename()) -> file:filename().
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_binary(Name1), is_list(Name2) ->
+ join(Name1,filename_string_to_binary(Name2));
+join(Name1, Name2) when is_list(Name1), is_binary(Name2) ->
+ join(filename_string_to_binary(Name1),Name2);
+join(Name1, Name2) when is_binary(Name1), is_binary(Name2) ->
+ OsType = major_os_type(),
+ case pathtype(Name2) of
+ relative -> join1b(Name1, Name2, [], OsType);
+ _Other -> join1b(Name2, <<>>, [], OsType)
+ end;
+
join(Name1, Name2) when is_atom(Name1) ->
join(atom_to_list(Name1), Name2);
join(Name1, Name2) when is_atom(Name2) ->
@@ -321,8 +345,6 @@ 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) ->
@@ -344,6 +366,26 @@ join1([Char|Rest], RelativeName, Result, OsType) when is_integer(Char) ->
join1([Atom|Rest], RelativeName, Result, OsType) when is_atom(Atom) ->
join1(atom_to_list(Atom)++Rest, RelativeName, Result, OsType).
+join1b(<<UcLetter, $:, Rest/binary>>, RelativeName, [], win32)
+when is_integer(UcLetter), UcLetter >= $A, UcLetter =< $Z ->
+ join1b(Rest, RelativeName, [$:, UcLetter+$a-$A], win32);
+join1b(<<$\\,Rest/binary>>, RelativeName, Result, win32) ->
+ join1b(<<$/,Rest>>, RelativeName, Result, win32);
+join1b(<<$/,Rest/binary>>, RelativeName, [$., $/|Result], OsType) ->
+ join1b(Rest, RelativeName, [$/|Result], OsType);
+join1b(<<$/,Rest/binary>>, RelativeName, [$/|Result], OsType) ->
+ join1b(Rest, RelativeName, [$/|Result], OsType);
+join1b(<<>>, <<>>, Result, OsType) ->
+ list_to_binary(maybe_remove_dirsep(Result, OsType));
+join1b(<<>>, RelativeName, [$:|Rest], win32) ->
+ join1b(RelativeName, <<>>, [$:|Rest], win32);
+join1b(<<>>, RelativeName, [$/|Result], OsType) ->
+ join1b(RelativeName, <<>>, [$/|Result], OsType);
+join1b(<<>>, RelativeName, Result, OsType) ->
+ join1b(RelativeName, <<>>, [$/|Result], OsType);
+join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) ->
+ join1b(Rest, RelativeName, [Char|Result], OsType).
+
maybe_remove_dirsep([$/, $:, Letter], win32) ->
[Letter, $:, $/];
maybe_remove_dirsep([$/], _) ->
@@ -357,7 +399,7 @@ maybe_remove_dirsep(Name, _) ->
%% a given base directory, which is is assumed to be normalised
%% by a previous call to join/{1,2}.
--spec append(string(), file:name()) -> string().
+-spec append(file:filename(), file:name()) -> file:filename().
append(Dir, Name) ->
Dir ++ [$/|Name].
@@ -376,19 +418,14 @@ append(Dir, Name) ->
-spec pathtype(file:name()) -> 'absolute' | 'relative' | 'volumerelative'.
pathtype(Atom) when is_atom(Atom) ->
pathtype(atom_to_list(Atom));
-pathtype(Name) when is_list(Name) ->
+pathtype(Name) when is_list(Name) or is_binary(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)
+ {win32, _} -> win32_pathtype(Name)
end.
+unix_pathtype(<<$/,_/binary>>) ->
+ absolute;
unix_pathtype([$/|_]) ->
absolute;
unix_pathtype([List|Rest]) when is_list(List) ->
@@ -404,6 +441,15 @@ 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(<<$/, $/, _/binary>>) -> absolute;
+win32_pathtype(<<$\\, $/, _/binary>>) -> absolute;
+win32_pathtype(<<$/, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<$\\, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<$/, _/binary>>) -> volumerelative;
+win32_pathtype(<<$\\, _/binary>>) -> volumerelative;
+win32_pathtype(<<_Letter, $:, $/, _/binary>>) -> absolute;
+win32_pathtype(<<_Letter, $:, $\\, _/binary>>) -> absolute;
+win32_pathtype(<<_Letter, $:, _/binary>>) -> volumerelative;
win32_pathtype([$/, $/|_]) -> absolute;
win32_pathtype([$\\, $/|_]) -> absolute;
win32_pathtype([$/, $\\|_]) -> absolute;
@@ -422,7 +468,7 @@ win32_pathtype(_) -> relative.
%% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle"
%% rootname("/jam.src/foo.erl") -> "/jam.src/foo"
--spec rootname(file:name()) -> string().
+-spec rootname(file:name()) -> file:filename().
rootname(Name0) ->
Name = flatten(Name0),
rootname(Name, [], [], major_os_type()).
@@ -431,8 +477,6 @@ 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) ->
@@ -451,7 +495,7 @@ rootname([], Root, _Ext, _OsType) ->
%% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam"
%% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo"
--spec rootname(file:name(), file:name()) -> string().
+-spec rootname(file:name(), file:name()) -> file:filename().
rootname(Name0, Ext0) ->
Name = flatten(Name0),
Ext = flatten(Ext0),
@@ -471,27 +515,55 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) ->
%% split("foo/bar") -> ["foo", "bar"]
%% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"]
--spec split(file:name()) -> [string()].
+-spec split(file:name()) -> [file:filename()].
+split(Name) when is_binary(Name) ->
+ case os:type() of
+ {win32, _} -> win32_splitb(Name);
+ _ -> unix_splitb(Name)
+ end;
+
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)
+ _ -> 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_splitb(Name) ->
+ L = binary:split(Name,[<<"/">>],[global]),
+ LL = case L of
+ [<<>>|Rest] ->
+ [<<"/">>|Rest];
+ _ ->
+ L
+ end,
+ [ X || X <- LL, X =/= <<>>].
+
+
+fix_driveletter(Letter0) ->
+ if
+ Letter0 >= $A, Letter0 =< $Z ->
+ Letter0+$a-$A;
+ true ->
+ Letter0
+ end.
+win32_splitb(<<Letter0,$:, Slash, Rest/binary>>) when (((Slash =:= $\\) orelse (Slash =:= $/)) andalso
+ ?IS_DRIVELETTER(Letter0)) ->
+ Letter = fix_driveletter(Letter0),
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<Letter,$:,$/>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(<<Letter0,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter0) ->
+ Letter = fix_driveletter(Letter0),
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<Letter,$:>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(<<Slash,Rest/binary>>) when ((Slash =:= $\\) orelse (Slash =:= $/)) ->
+ L = binary:split(Rest,[<<"/">>,<<"\\">>],[global]),
+ [<<$/>> | [ X || X <- L, X =/= <<>> ]];
+win32_splitb(Name) ->
+ L = binary:split(Name,[<<"/">>,<<"\\">>],[global]),
+ [<<$/>> | [ X || X <- L, X =/= <<>> ]].
+
unix_split(Name) ->
split(Name, [], unix).
@@ -502,8 +574,6 @@ 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]) ->
@@ -540,7 +610,7 @@ split([], Comp, Components, OsType) ->
%% will be converted to backslashes. On all platforms, the
%% name will be normalized as done by join/1.
--spec nativename(string()) -> string().
+-spec nativename(file:filename()) -> file:filename().
nativename(Name0) ->
Name = join([Name0]), %Normalize.
case os:type() of
@@ -557,13 +627,12 @@ win32_nativename([]) ->
separators() ->
case os:type() of
- {unix, _} -> {false, false};
{win32, _} -> {$\\, $:};
- vxworks -> {$\\, false};
- {ose,_} -> {false, false}
+ _ -> {false, false}
end.
+
%% find_src(Module) --
%% find_src(Module, Rules) --
%%
@@ -733,45 +802,12 @@ major_os_type() ->
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(file:name()) -> string().
+-spec flatten(file:name()) -> file:filename().
+flatten(Bin) when is_binary(Bin) ->
+ Bin;
flatten(List) ->
do_flatten(List, []).
@@ -785,3 +821,12 @@ do_flatten([], Tail) ->
Tail;
do_flatten(Atom, Tail) when is_atom(Atom) ->
atom_to_list(Atom) ++ flatten(Tail).
+
+filename_string_to_binary(List) ->
+ case unicode:characters_to_binary(List,unicode,file:native_name_encoding()) of
+ {error,_,_} ->
+ erlang:error(badarg);
+ Bin when is_binary(Bin) ->
+ Bin
+ end.
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 09:41:59 +0000