Get file & directory names in directory dir
using iso_c_binding.
dir
.
except current directory and parent directoryType | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | dir | |||
type(string_t), | intent(out), | allocatable | :: | files(:) | ||
logical, | intent(in), | optional | :: | recurse |
recursive subroutine list_files(dir, files, recurse)
character(len=*), intent(in) :: dir
type(string_t), allocatable, intent(out) :: files(:)
logical, intent(in), optional :: recurse
integer :: i
type(string_t), allocatable :: dir_files(:)
type(string_t), allocatable :: sub_dir_files(:)
type(c_ptr) :: dir_handle
type(c_ptr) :: dir_entry_c
character(len=:,kind=c_char), allocatable :: fortran_name
character(len=:), allocatable :: string_fortran
integer, parameter :: N_MAX = 256
type(string_t) :: files_tmp(N_MAX)
integer(kind=c_int) :: r
if (c_is_dir(dir(1:len_trim(dir))//c_null_char) == 0) then
allocate (files(0))
return
end if
dir_handle = c_opendir(dir(1:len_trim(dir))//c_null_char)
if (.not. c_associated(dir_handle)) then
print *, 'c_opendir() failed'
error stop
end if
i = 0
allocate(files(0))
do
dir_entry_c = c_readdir(dir_handle)
if (.not. c_associated(dir_entry_c)) then
exit
else
string_fortran = f_string(c_get_d_name(dir_entry_c))
if ((string_fortran == '.' .or. string_fortran == '..')) then
cycle
end if
i = i + 1
if (i > N_MAX) then
files = [files, files_tmp]
i = 1
end if
files_tmp(i)%s = join_path(dir, string_fortran)
end if
end do
r = c_closedir(dir_handle)
if (r /= 0) then
print *, 'c_closedir() failed'
error stop
end if
if (i > 0) then
files = [files, files_tmp(1:i)]
end if
if (present(recurse)) then
if (recurse) then
allocate(sub_dir_files(0))
do i=1,size(files)
if (c_is_dir(files(i)%s//c_null_char) /= 0) then
call list_files(files(i)%s, dir_files, recurse=.true.)
sub_dir_files = [sub_dir_files, dir_files]
end if
end do
files = [files, sub_dir_files]
end if
end if
end subroutine list_files