Fortran · 7344 bytes Raw Blame History
1 ! Filesystem operations for Fortress navigator (adapted for fac)
2 ! Original source: fortress/src/filesystem/fs_ops.f90
3
4 module fortress_fs_module
5 implicit none
6 private
7
8 public :: get_file_list, get_pwd, get_parent_path, join_path
9 public :: find_in_parent, find_file_in_list
10 public :: MAX_PATH, MAX_FILES
11
12 integer, parameter :: MAX_PATH = 512
13 integer, parameter :: MAX_FILES = 500
14
15 contains
16
17 subroutine get_file_list(dir, files, is_dir, is_exec, count)
18 character(len=*), intent(in) :: dir
19 character(len=*), dimension(*), intent(out) :: files
20 logical, dimension(*), intent(out) :: is_dir, is_exec
21 integer, intent(out) :: count
22 integer :: unit, ios, i, stat_code
23 character(len=MAX_PATH) :: temp_file, stat_file
24 character(len=MAX_PATH) :: line, filename, file_type
25
26 ! Get list of files
27 call get_environment_variable("HOME", temp_file)
28 temp_file = trim(temp_file) // "/.fac_fortress_ls"
29 stat_file = trim(temp_file) // "_stat"
30
31 call execute_command_line("ls -1a '" // trim(dir) // "' > " // trim(temp_file) // " 2>/dev/null", wait=.true.)
32
33 open(newunit=unit, file=temp_file, status='old', iostat=ios)
34 if (ios /= 0) then
35 count = 0
36 call execute_command_line("rm -f " // trim(temp_file) // " 2>/dev/null")
37 return
38 end if
39
40 ! Read all filenames first
41 count = 0
42 do
43 count = count + 1
44 if (count > MAX_FILES) exit
45 read(unit, '(a)', iostat=ios) files(count)
46 if (ios /= 0) then
47 count = count - 1
48 exit
49 end if
50 end do
51 close(unit)
52
53 ! Now check file attributes - use simpler approach with stat via ls
54 ! Generate a script that checks each file and outputs "filename:type"
55 call execute_command_line("cd '" // trim(dir) // "' && " // &
56 "for f in $(ls -1a 2>/dev/null); do " // &
57 " if [ -d ""$f"" ]; then echo ""$f:d""; " // &
58 " elif [ -x ""$f"" ] && [ ! -d ""$f"" ]; then echo ""$f:x""; " // &
59 " else echo ""$f:f""; fi; " // &
60 "done > " // trim(stat_file) // " 2>/dev/null", wait=.true.)
61
62 ! Initialize all as regular non-executable files
63 do i = 1, count
64 is_dir(i) = .false.
65 is_exec(i) = .false.
66 end do
67
68 ! Read the stat results and update file types
69 open(newunit=unit, file=stat_file, status='old', iostat=ios)
70 if (ios == 0) then
71 do
72 read(unit, '(a)', iostat=ios) line
73 if (ios /= 0) exit
74
75 ! Parse "filename:type" format
76 stat_code = index(line, ':', back=.true.)
77 if (stat_code > 0) then
78 filename = line(1:stat_code-1)
79 file_type = line(stat_code+1:stat_code+1)
80
81 ! Find this file in our list and update its type
82 do i = 1, count
83 if (trim(files(i)) == trim(filename)) then
84 if (file_type == 'd') then
85 is_dir(i) = .true.
86 is_exec(i) = .false.
87 else if (file_type == 'x') then
88 is_dir(i) = .false.
89 is_exec(i) = .true.
90 else
91 is_dir(i) = .false.
92 is_exec(i) = .false.
93 end if
94 exit
95 end if
96 end do
97 end if
98 end do
99 close(unit)
100 end if
101
102 ! Cleanup temp files
103 call execute_command_line("rm -f " // trim(temp_file) // " " // trim(stat_file) // " 2>/dev/null")
104
105 ! Filter out "." and ".." entries
106 call filter_dot_entries(files, is_dir, is_exec, count)
107 end subroutine get_file_list
108
109 !> Filter out "." and ".." from file list
110 subroutine filter_dot_entries(files, is_dir, is_exec, count)
111 character(len=*), dimension(*), intent(inout) :: files
112 logical, dimension(*), intent(inout) :: is_dir, is_exec
113 integer, intent(inout) :: count
114 integer :: i, j
115
116 j = 0
117 do i = 1, count
118 if (trim(files(i)) /= "." .and. trim(files(i)) /= "..") then
119 j = j + 1
120 if (i /= j) then
121 files(j) = files(i)
122 is_dir(j) = is_dir(i)
123 is_exec(j) = is_exec(i)
124 end if
125 end if
126 end do
127 count = j
128 end subroutine filter_dot_entries
129
130 function get_pwd() result(path)
131 character(len=MAX_PATH) :: path
132 integer :: unit, ios
133
134 call execute_command_line("pwd > .fac_pwd 2>/dev/null", wait=.true.)
135 open(newunit=unit, file=".fac_pwd", status='old', iostat=ios)
136 if (ios == 0) then
137 read(unit, '(a)') path
138 close(unit)
139 else
140 path = "."
141 end if
142 call execute_command_line("rm -f .fac_pwd 2>/dev/null")
143 end function get_pwd
144
145 function get_parent_path(path) result(parent)
146 character(len=*), intent(in) :: path
147 character(len=MAX_PATH) :: parent
148 integer :: pos
149
150 pos = index(path, "/", back=.true.)
151 if (pos > 1) then
152 parent = path(1:pos-1)
153 else if (pos == 1) then
154 parent = "/"
155 else
156 parent = "."
157 end if
158 end function get_parent_path
159
160 function join_path(base, name) result(full)
161 character(len=*), intent(in) :: base, name
162 character(len=MAX_PATH) :: full
163
164 if (base == "/") then
165 full = "/" // trim(name)
166 else
167 full = trim(base) // "/" // trim(name)
168 end if
169 end function join_path
170
171 function find_in_parent(dir, files, count) result(idx)
172 character(len=*), intent(in) :: dir
173 character(len=*), dimension(*), intent(in) :: files
174 integer, intent(in) :: count
175 integer :: idx, pos
176 character(len=256) :: basename
177
178 pos = index(dir, "/", back=.true.)
179 if (pos > 0) then
180 basename = dir(pos+1:)
181 else
182 basename = dir
183 end if
184
185 do idx = 1, count
186 if (trim(files(idx)) == trim(basename)) return
187 end do
188 idx = 1
189 end function find_in_parent
190
191 function find_file_in_list(target_path, files, count) result(idx)
192 character(len=*), intent(in) :: target_path
193 character(len=*), dimension(*), intent(in) :: files
194 integer, intent(in) :: count
195 integer :: idx, pos
196 character(len=MAX_PATH) :: basename
197
198 ! Extract basename from target_path
199 pos = index(target_path, "/", back=.true.)
200 if (pos > 0) then
201 basename = target_path(pos+1:)
202 else
203 basename = target_path
204 end if
205
206 ! Search for the file in the list
207 do idx = 1, count
208 if (trim(files(idx)) == trim(basename)) return
209 end do
210
211 ! Default to first item if not found
212 idx = 1
213 end function find_file_in_list
214
215 end module fortress_fs_module
216