| 1 | module file_system |
| 2 | use iso_c_binding |
| 3 | use iso_fortran_env, only: int64 |
| 4 | implicit none |
| 5 | private |
| 6 | |
| 7 | public :: get_file_size, is_directory, is_symlink, list_directory, get_path_separator, is_running_as_root |
| 8 | public :: delete_path, get_absolute_path |
| 9 | |
| 10 | ! POSIX stat structure (simplified) |
| 11 | type, bind(c) :: c_stat |
| 12 | integer(c_long) :: st_dev |
| 13 | integer(c_long) :: st_ino |
| 14 | integer(c_int) :: st_mode |
| 15 | integer(c_long) :: st_nlink |
| 16 | integer(c_int) :: st_uid |
| 17 | integer(c_int) :: st_gid |
| 18 | integer(c_long) :: st_rdev |
| 19 | integer(c_long) :: st_size |
| 20 | integer(c_long) :: st_blksize |
| 21 | integer(c_long) :: st_blocks |
| 22 | integer(c_long) :: st_atime |
| 23 | integer(c_long) :: st_mtime |
| 24 | integer(c_long) :: st_ctime |
| 25 | end type c_stat |
| 26 | |
| 27 | ! POSIX dirent structure (simplified, platform-specific) |
| 28 | ! On macOS, d_name is 256 bytes, but other fields vary |
| 29 | type, bind(c) :: c_dirent |
| 30 | integer(c_long) :: d_ino |
| 31 | integer(c_short) :: d_reclen |
| 32 | integer(c_int8_t) :: d_type |
| 33 | integer(c_int8_t) :: d_namlen |
| 34 | character(kind=c_char) :: d_name(256) |
| 35 | end type c_dirent |
| 36 | |
| 37 | ! File type constants |
| 38 | integer(c_int), parameter :: S_IFDIR = int(o'040000', c_int) |
| 39 | integer(c_int), parameter :: S_IFLNK = int(o'120000', c_int) |
| 40 | integer(c_int), parameter :: S_IFMT = int(o'170000', c_int) |
| 41 | |
| 42 | ! dirent d_type constants (not currently used, but available) |
| 43 | integer(c_int8_t), parameter :: DT_DIR = 4 |
| 44 | integer(c_int8_t), parameter :: DT_REG = 8 |
| 45 | integer(c_int8_t), parameter :: DT_LNK = 10 |
| 46 | |
| 47 | interface |
| 48 | ! C helper functions |
| 49 | function list_dir_helper(path, names, max_entries) bind(c, name="list_dir_helper") |
| 50 | use iso_c_binding |
| 51 | type(c_ptr), value :: path |
| 52 | character(kind=c_char), dimension(*) :: names |
| 53 | integer(c_int), value :: max_entries |
| 54 | integer(c_int) :: list_dir_helper |
| 55 | end function list_dir_helper |
| 56 | |
| 57 | function is_dir_helper(path) bind(c, name="is_dir_helper") |
| 58 | use iso_c_binding |
| 59 | type(c_ptr), value :: path |
| 60 | integer(c_int) :: is_dir_helper |
| 61 | end function is_dir_helper |
| 62 | |
| 63 | function is_link_helper(path) bind(c, name="is_link_helper") |
| 64 | use iso_c_binding |
| 65 | type(c_ptr), value :: path |
| 66 | integer(c_int) :: is_link_helper |
| 67 | end function is_link_helper |
| 68 | |
| 69 | function get_size_helper(path) bind(c, name="get_size_helper") |
| 70 | use iso_c_binding |
| 71 | type(c_ptr), value :: path |
| 72 | integer(c_long_long) :: get_size_helper |
| 73 | end function get_size_helper |
| 74 | |
| 75 | function is_running_as_root_helper() bind(c, name="is_running_as_root") |
| 76 | use iso_c_binding |
| 77 | integer(c_int) :: is_running_as_root_helper |
| 78 | end function is_running_as_root_helper |
| 79 | |
| 80 | function get_absolute_path_helper(path, result, result_len) bind(c, name="get_absolute_path") |
| 81 | use iso_c_binding |
| 82 | type(c_ptr), value :: path |
| 83 | character(kind=c_char), dimension(*) :: result |
| 84 | integer(c_int), value :: result_len |
| 85 | integer(c_int) :: get_absolute_path_helper |
| 86 | end function get_absolute_path_helper |
| 87 | end interface |
| 88 | |
| 89 | contains |
| 90 | |
| 91 | ! Get file size in bytes |
| 92 | function get_file_size(filepath) result(size) |
| 93 | character(len=*), intent(in) :: filepath |
| 94 | integer(int64) :: size |
| 95 | character(len=len(filepath)+1, kind=c_char), target :: c_path |
| 96 | integer(c_long_long) :: c_size |
| 97 | |
| 98 | c_path = trim(filepath) // c_null_char |
| 99 | c_size = get_size_helper(c_loc(c_path)) |
| 100 | size = int(c_size, int64) |
| 101 | end function get_file_size |
| 102 | |
| 103 | ! Check if path is a directory |
| 104 | function is_directory(filepath) result(is_dir) |
| 105 | character(len=*), intent(in) :: filepath |
| 106 | logical :: is_dir |
| 107 | character(len=len(filepath)+1, kind=c_char), target :: c_path |
| 108 | integer(c_int) :: result |
| 109 | |
| 110 | c_path = trim(filepath) // c_null_char |
| 111 | result = is_dir_helper(c_loc(c_path)) |
| 112 | is_dir = (result /= 0) |
| 113 | end function is_directory |
| 114 | |
| 115 | ! Check if path is a symbolic link |
| 116 | function is_symlink(filepath) result(is_link) |
| 117 | character(len=*), intent(in) :: filepath |
| 118 | logical :: is_link |
| 119 | character(len=len(filepath)+1, kind=c_char), target :: c_path |
| 120 | integer(c_int) :: result |
| 121 | |
| 122 | c_path = trim(filepath) // c_null_char |
| 123 | result = is_link_helper(c_loc(c_path)) |
| 124 | is_link = (result /= 0) |
| 125 | end function is_symlink |
| 126 | |
| 127 | ! List directory contents using C helper |
| 128 | function list_directory(dirpath, entries, max_entries) result(num_entries) |
| 129 | character(len=*), intent(in) :: dirpath |
| 130 | character(len=256), dimension(:), intent(out) :: entries |
| 131 | integer, intent(in) :: max_entries |
| 132 | integer :: num_entries |
| 133 | |
| 134 | character(len=len(dirpath)+1, kind=c_char), target :: c_path |
| 135 | character(kind=c_char), dimension(256*max_entries), target :: c_names |
| 136 | integer(c_int) :: c_count |
| 137 | integer :: i, j, name_start, name_len |
| 138 | |
| 139 | num_entries = 0 |
| 140 | c_path = trim(dirpath) // c_null_char |
| 141 | |
| 142 | ! Call C helper to get directory names |
| 143 | c_count = list_dir_helper(c_loc(c_path), c_names, int(max_entries, c_int)) |
| 144 | num_entries = int(c_count) |
| 145 | |
| 146 | ! Extract names from C array |
| 147 | do i = 1, num_entries |
| 148 | name_start = (i - 1) * 256 + 1 |
| 149 | entries(i) = '' |
| 150 | name_len = 0 |
| 151 | |
| 152 | ! Copy characters until null terminator |
| 153 | do j = 0, 255 |
| 154 | if (c_names(name_start + j) == c_null_char) exit |
| 155 | entries(i)(j+1:j+1) = c_names(name_start + j) |
| 156 | name_len = j + 1 |
| 157 | end do |
| 158 | end do |
| 159 | end function list_directory |
| 160 | |
| 161 | ! Get platform-specific path separator |
| 162 | function get_path_separator() result(sep) |
| 163 | character(len=1) :: sep |
| 164 | ! Unix/Linux/macOS use forward slash |
| 165 | sep = '/' |
| 166 | end function get_path_separator |
| 167 | |
| 168 | ! Check if running as root (sudo) |
| 169 | function is_running_as_root() result(is_root) |
| 170 | logical :: is_root |
| 171 | integer(c_int) :: result |
| 172 | |
| 173 | result = is_running_as_root_helper() |
| 174 | is_root = (result /= 0) |
| 175 | end function is_running_as_root |
| 176 | |
| 177 | ! Delete a file or directory, trying 'trash' command first, then rm -rf |
| 178 | function delete_path(path) result(success) |
| 179 | character(len=*), intent(in) :: path |
| 180 | logical :: success |
| 181 | integer :: exit_code |
| 182 | character(len=1024) :: command |
| 183 | |
| 184 | ! First try using 'trash' command (safer) |
| 185 | write(command, '(A,A,A)') 'trash "', trim(path), '" 2>/dev/null' |
| 186 | call execute_command_line(trim(command), exitstat=exit_code) |
| 187 | |
| 188 | if (exit_code == 0) then |
| 189 | success = .true. |
| 190 | return |
| 191 | end if |
| 192 | |
| 193 | ! Trash not available or failed, try rm -rf |
| 194 | if (is_directory(path)) then |
| 195 | write(command, '(A,A,A)') 'rm -rf "', trim(path), '"' |
| 196 | else |
| 197 | write(command, '(A,A,A)') 'rm -f "', trim(path), '"' |
| 198 | end if |
| 199 | |
| 200 | call execute_command_line(trim(command), exitstat=exit_code) |
| 201 | success = (exit_code == 0) |
| 202 | end function delete_path |
| 203 | |
| 204 | ! Get absolute path from relative or absolute path |
| 205 | function get_absolute_path(path) result(abs_path) |
| 206 | character(len=*), intent(in) :: path |
| 207 | character(len=:), allocatable :: abs_path |
| 208 | character(kind=c_char, len=512), target :: c_path, c_result |
| 209 | integer(c_int) :: result_code, i, path_len |
| 210 | |
| 211 | ! Convert Fortran string to C string |
| 212 | c_path = trim(path) // c_null_char |
| 213 | |
| 214 | ! Call C helper |
| 215 | result_code = get_absolute_path_helper(c_loc(c_path), c_result, 512_c_int) |
| 216 | |
| 217 | if (result_code == 0) then |
| 218 | ! Failed to resolve, return original path |
| 219 | abs_path = trim(path) |
| 220 | return |
| 221 | end if |
| 222 | |
| 223 | ! Convert C string back to Fortran string |
| 224 | path_len = 0 |
| 225 | do i = 1, 512 |
| 226 | if (c_result(i:i) == c_null_char) exit |
| 227 | path_len = path_len + 1 |
| 228 | end do |
| 229 | |
| 230 | allocate(character(len=path_len) :: abs_path) |
| 231 | abs_path = c_result(1:path_len) |
| 232 | end function get_absolute_path |
| 233 | |
| 234 | end module file_system |
| 235 |