module utilities #ifdef WINDOWS character, parameter::dir_sep = '\' #else character, parameter::dir_sep = '/' #endif integer, parameter::DIR_LIST_STRING_LENGTH = 128 interface replace_field module procedure replace_field_text module procedure replace_field_int end interface contains function is_absolute_path(path) implicit none logical::is_absolute_path character(len=*), intent(in)::path is_absolute_path = .false. if(path(1:1) == dir_sep) then is_absolute_path = .true. else #ifdef WINDOWS if(path(2:2) == ":") then is_absolute_path = .true. end if #endif end if end function is_absolute_path subroutine combine_paths(first, second, res) implicit none character(len=*), intent(in)::first, second character(len=*), intent(out)::res integer::i i = len_trim(first) if(first(i:i) == dir_sep) then res = trim(first)//trim(second) else res = trim(first)//dir_sep//trim(second) end if end subroutine combine_paths subroutine write_date_and_time(unit_number, values) implicit none integer, intent(in)::unit_number integer, intent(in), dimension(8)::values write(unit_number, '(I4, A1, I0.2, A1, I0.2, 1X, I2, A1, I0.2, A1, I0.2)') & values(1), "-", & values(2), "-", & values(3), & values(5), ":", & values(6), ":", & values(7) end subroutine write_date_and_time function remove_directory(absolute_dir, and_files) implicit none character(*), intent(in)::absolute_dir logical, intent(in), optional::and_files logical::remove_directory character(len=8)::cmd, flags integer::retval #ifdef WINDOWS flags = " " cmd = "rmdir" #else flags = "-rf" cmd = "rm" #endif if(present(and_files)) then if(and_files) then #ifdef WINDOWS flags = "/S /Q" #else flags = "-rf" #endif end if end if call execute_command_line(trim(cmd)//" "//trim(flags)//" "//trim(absolute_dir), & wait=.true., exitstat=retval) remove_directory = (retval == 0) end function remove_directory function read_into_buffer(unit_number, buffer) implicit none integer, intent(in)::unit_number character, dimension(*), intent(out)::buffer integer::read_into_buffer integer::i, ierr ierr = 0 i = 0 do while(ierr == 0 .and. i < len(buffer)) i = i + 1 read(unit_number, iostat=ierr) buffer(i) end do if(ierr /= 0) then i = i - 1 end if read_into_buffer = i end function read_into_buffer function generate_temporary_filename() result(fullpath) use iso_c_binding implicit none character(len=:), pointer::fullpath type(c_ptr)::tmp_name character(kind=c_char), dimension(:), pointer::cfullpath integer(kind=c_size_t)::clength integer::i interface function c_strlen(p) bind(c, name='strlen') use iso_c_binding type(c_ptr), value::p integer(kind=c_size_t)::strlen end function c_strlen function c_malloc(x) bind(c, name='malloc') use iso_c_binding type(c_ptr)::c_malloc integer(kind=c_size_t), value::x end function c_malloc subroutine c_free(p) bind(c, name='free') use iso_c_binding type(c_ptr), value::p end subroutine c_free end interface #ifdef WINDOWS interface function GetTempPath(n, b) bind(c, name='GetTempPathA') use iso_c_binding integer(kind=c_int32_t)::GetTempPath integer(kind=c_int32_t), value::n type(c_ptr), value::b end function GetTempPath function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA') use iso_c_binding integer(kind=c_int)::GetTempFileName integer(kind=c_int), value::unique type(c_ptr), value::pn, prefix, b end function GetTempFileName end interface type(c_ptr)::tmp_path integer::res tmp_path = c_malloc(int(1024, kind=c_size_t)) res = GetTempPath(1023, tmp_path) tmp_name = c_malloc(int(1024, kind=c_size_t)) res = GetTempFileName(tmp_path, c_null_ptr, 0, tmp_name) call c_free(tmp_path) ! Convert the C Ptr to a Fortran object clength = c_strlen(tmp_name) if(clength == 0) then stop end if call c_f_pointer(tmp_name, cfullpath, (/ clength /)) allocate(character(len=clength)::fullpath) do i = 1, clength fullpath(i:i) = cfullpath(i) end do cfullpath => null() call c_free(tmp_name) #else character(32)::num_text real::rnum allocate(character(len=1024) :: fullpath) call random_number(rnum) write(num_text, *) abs(rnum) fullpath = "/tmp/lv."//trim(adjustl(num_text))//".tmp" !call write_log("My temp filename is: '"//trim(fullpath)//"'") #endif end function generate_temporary_filename subroutine delete_file(filename) implicit none character(*), intent(in)::filename #ifdef GNU call unlink(filename) #else ! Not implemented... #endif end subroutine delete_file subroutine replace_field_text(str, field, val) implicit none character(*), intent(inout)::str character(*), intent(in)::field character(*), intent(in)::val character(len=:), allocatable::holding integer::length_estimate integer::field_location, i ! This is too big, but close enough length_estimate = len_trim(str) + len_trim(val) allocate(character(len=length_estimate) :: holding) holding = " " ! Find the field field_location = index(str, "{"//trim(field)//"}") if(field_location > 0) then i = field_location + len_trim(field) + 2 holding = str(1:field_location-1)//trim(val)//str(i:len_trim(str)) ! Put the results back now str = holding end if deallocate(holding) end subroutine replace_field_text subroutine replace_field_int(str, field, val) implicit none character(*), intent(inout)::str character(*), intent(in)::field integer, intent(in)::val character(16)::int_text write(int_text, *) val call replace_field_text(str, field, trim(adjustl(int_text))) end subroutine replace_field_int function get_directories_in_directory(directory) result(res) implicit none character(*), intent(in)::directory character(DIR_LIST_STRING_LENGTH), dimension(:), pointer::res character(80)::line character(len=:), pointer::tempfile integer::dcount, unum, ierr, i tempfile => generate_temporary_filename() res => null() #ifdef WINDOWS call execute_command_line("dir /b/ad-h"//trim(directory)//" > "//trim(tempfile), & wait=.true.) #else call execute_command_line("ls -l "//trim(directory)//" > "//trim(tempfile), & wait=.true.) #endif open(newunit=unum, file=tempfile, action='read') #ifndef WINDOWS ! First line is "total ###" read(unum, '(A)', iostat=ierr) line #endif dcount = 0 read(unum, '(A)', iostat=ierr) line do while(ierr == 0) #ifdef WINDOWS if(len_trim(line) > 0) then dcount = dcount + 1 end if #else if(line(1:1) == 'd') then dcount = dcount + 1 end if #endif read(unum, '(A)', iostat=ierr) line end do close(unum) if(dcount > 0) then allocate(res(dcount)) ! Windows is all set, don't call anything #ifndef WINDOWS ! Now call ls, but group directories first call execute_command_line("ls --group-directories-first "//trim(directory)//" > "//trim(tempfile), & wait=.true.) #endif open(newunit=unum, file=tempfile, action='read') i = 0 read(unum, '(A)', iostat=ierr) line do while(ierr == 0 .and. i < dcount) i = i + 1 res(i) = trim(line) read(unum, '(A)', iostat=ierr) line end do close(unum) end if call unlink(tempfile) end function get_directories_in_directory function get_files_in_directory(directory) result(res) implicit none character(*), intent(in)::directory character(DIR_LIST_STRING_LENGTH), dimension(:), pointer::res character(80)::line character(len=:), pointer::tempfile integer::dcount, total_count, unum, ierr, i, n tempfile => generate_temporary_filename() res => null() #ifdef WINDOWS call execute_command_line("dir /b/a-d-h"//trim(directory)//" > "//trim(tempfile), & wait=.true.) #else call execute_command_line("ls -l "//trim(directory)//" > "//trim(tempfile), & wait=.true.) #endif open(newunit=unum, file=tempfile, action='read') dcount = 0 total_count = 0 ! Count directories first read(unum, '(A)', iostat=ierr) line do while(ierr == 0) #ifndef WINDOWS if(line(1:1) == 'd') then dcount = dcount + 1 end if #endif ! ls puts a nonsense entry first. harmless, but we don't want it if(line(1:6) /= "total " .and. len_trim(line) > 0) then total_count = total_count + 1 end if read(unum, '(A)', iostat=ierr) line end do close(unum) n = total_count - dcount !print *, "Total: ", total_count, "Dirs:", dcount, "Files:", n if(n > 0) then allocate(res(n)) !print *, "Size: ", size(res) ! We don't need to recreate the file on Windows. It's fine. #ifndef WINDOWS ! Now call ls, but group directories first call execute_command_line("ls --group-directories-first "//trim(directory)//" > "//trim(tempfile), & wait=.true.) #endif open(newunit=unum, file=tempfile, action='read') i = 0 ! First, skip directories do while(i < dcount) read(unum, '(A)', iostat=ierr) line if(line(1:6) /= "total ") then i = i + 1 end if end do ! Now we can read files i = 0 read(unum, '(A)', iostat=ierr) line do while(ierr == 0 .and. i < n) if(line(1:6) /= "total ") then i = i + 1 res(i) = trim(line) !print *, i, trim(res(i))//"|" end if read(unum, '(A)', iostat=ierr) line end do close(unum) end if call unlink(tempfile) end function get_files_in_directory end module utilities