1 | module m_reader |
---|
2 | |
---|
3 | use m_io |
---|
4 | |
---|
5 | private |
---|
6 | |
---|
7 | integer, parameter, public :: BUFFER_NOT_CONNECTED = -2048 |
---|
8 | integer, private, parameter :: MAXLENGTH = 1024 |
---|
9 | |
---|
10 | type, public :: file_buffer_t |
---|
11 | private |
---|
12 | logical :: connected |
---|
13 | logical :: eof |
---|
14 | integer :: lun |
---|
15 | character(len=50) :: filename |
---|
16 | integer :: counter |
---|
17 | character(len=MAXLENGTH) :: buffer |
---|
18 | integer :: line |
---|
19 | integer :: col |
---|
20 | integer :: pos |
---|
21 | integer :: nchars |
---|
22 | logical :: debug |
---|
23 | end type file_buffer_t |
---|
24 | |
---|
25 | public :: get_character, sync_file |
---|
26 | public :: line, column, nchars_processed |
---|
27 | public :: open_file, close_file_buffer, rewind_file, mark_eof_file |
---|
28 | public :: eof_file |
---|
29 | |
---|
30 | private :: fill_buffer |
---|
31 | |
---|
32 | CONTAINS |
---|
33 | |
---|
34 | !----------------------------------------- |
---|
35 | ! |
---|
36 | subroutine open_file(fname,fb,iostat,record_size,verbose) |
---|
37 | character(len=*), intent(in) :: fname |
---|
38 | type(file_buffer_t), intent(out) :: fb |
---|
39 | integer, intent(out) :: iostat |
---|
40 | integer, intent(in), optional :: record_size |
---|
41 | logical, intent(in), optional :: verbose |
---|
42 | |
---|
43 | iostat = 0 |
---|
44 | |
---|
45 | call setup_io() |
---|
46 | |
---|
47 | fb%connected = .false. |
---|
48 | |
---|
49 | call get_unit(fb%lun,iostat) |
---|
50 | if (iostat /= 0) then |
---|
51 | if (fb%debug) print *, "Cannot get unit" |
---|
52 | return |
---|
53 | endif |
---|
54 | |
---|
55 | if (present(verbose)) then |
---|
56 | fb%debug = verbose |
---|
57 | else |
---|
58 | fb%debug = .false. |
---|
59 | endif |
---|
60 | |
---|
61 | if (present(record_size)) then |
---|
62 | open(unit=fb%lun,file=fname,form="formatted",status="old", & |
---|
63 | action="read",position="rewind",recl=record_size,iostat=iostat) |
---|
64 | else |
---|
65 | open(unit=fb%lun,file=fname,form="formatted",status="old", & |
---|
66 | action="read",position="rewind",recl=65536,iostat=iostat) |
---|
67 | endif |
---|
68 | if (iostat /= 0) then |
---|
69 | if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat |
---|
70 | return |
---|
71 | endif |
---|
72 | |
---|
73 | fb%connected = .true. |
---|
74 | fb%counter = 0 |
---|
75 | fb%eof = .false. |
---|
76 | fb%line = 1 |
---|
77 | fb%col = 0 |
---|
78 | fb%filename = fname |
---|
79 | fb%pos = 0 |
---|
80 | fb%nchars = 0 |
---|
81 | fb%buffer = "" |
---|
82 | |
---|
83 | end subroutine open_file |
---|
84 | |
---|
85 | !------------------------------------------------- |
---|
86 | subroutine rewind_file(fb) |
---|
87 | type(file_buffer_t), intent(inout) :: fb |
---|
88 | |
---|
89 | fb%eof = .false. |
---|
90 | fb%counter = 0 |
---|
91 | fb%line = 1 |
---|
92 | fb%col = 0 |
---|
93 | fb%pos = 0 |
---|
94 | fb%nchars = 0 |
---|
95 | fb%buffer = "" |
---|
96 | |
---|
97 | rewind(unit=fb%lun) |
---|
98 | |
---|
99 | end subroutine rewind_file |
---|
100 | !----------------------------------------- |
---|
101 | subroutine mark_eof_file(fb) |
---|
102 | type(file_buffer_t), intent(inout) :: fb |
---|
103 | |
---|
104 | fb%eof = .true. |
---|
105 | |
---|
106 | end subroutine mark_eof_file |
---|
107 | |
---|
108 | !----------------------------------------- |
---|
109 | subroutine close_file_buffer(fb) |
---|
110 | type(file_buffer_t), intent(inout) :: fb |
---|
111 | |
---|
112 | if (fb%connected) then |
---|
113 | close(unit=fb%lun) |
---|
114 | fb%connected = .false. |
---|
115 | endif |
---|
116 | |
---|
117 | end subroutine close_file_buffer |
---|
118 | |
---|
119 | !------------------------------------------------- |
---|
120 | function eof_file(fb) result (res) |
---|
121 | type(file_buffer_t), intent(in) :: fb |
---|
122 | logical :: res |
---|
123 | |
---|
124 | res = fb%eof |
---|
125 | |
---|
126 | end function eof_file |
---|
127 | !----------------------------------------- |
---|
128 | !----------------------------------------- |
---|
129 | ! New version, able to cope with arbitrarily long lines |
---|
130 | ! (still need to specify a big enough record_size if necessary) |
---|
131 | ! |
---|
132 | subroutine fill_buffer(fb,iostat) |
---|
133 | type(file_buffer_t), intent(inout) :: fb |
---|
134 | integer, intent(out) :: iostat |
---|
135 | ! |
---|
136 | ! |
---|
137 | character(len=41) :: str ! 40 seems like a good compromise? |
---|
138 | ! (1 extra for added newline, see below) |
---|
139 | integer :: len |
---|
140 | ! |
---|
141 | read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a40)") str |
---|
142 | |
---|
143 | if (iostat == io_eof) then |
---|
144 | |
---|
145 | ! End of file |
---|
146 | if (fb%debug) print *, "End of file." |
---|
147 | return |
---|
148 | |
---|
149 | else if (iostat > 0) then |
---|
150 | |
---|
151 | ! Hard i/o error |
---|
152 | if (fb%debug) print *, "Hard i/o error. iostat:", iostat |
---|
153 | RETURN |
---|
154 | |
---|
155 | else |
---|
156 | ! |
---|
157 | if (fb%debug) then |
---|
158 | print *, "Buffer: len, iostat", len, iostat |
---|
159 | print *, trim(str) |
---|
160 | endif |
---|
161 | |
---|
162 | fb%pos = 0 |
---|
163 | |
---|
164 | if (iostat == 0) then |
---|
165 | |
---|
166 | ! Normal read, with more stuff left on the line |
---|
167 | ! |
---|
168 | fb%buffer = str(1:len) |
---|
169 | fb%nchars = len |
---|
170 | |
---|
171 | else ! (end of record) |
---|
172 | ! |
---|
173 | ! End of record. We mark it with an LF, whatever it is the native marker. |
---|
174 | ! |
---|
175 | !! fb%buffer = str(1:len) // char(10) |
---|
176 | fb%buffer = str(1:len) !! Avoid allocation of string |
---|
177 | len = len + 1 !! by compiler |
---|
178 | fb%buffer(len:len) = char(10) |
---|
179 | fb%nchars = len |
---|
180 | iostat = 0 |
---|
181 | endif |
---|
182 | |
---|
183 | endif |
---|
184 | |
---|
185 | end subroutine fill_buffer |
---|
186 | |
---|
187 | !--------------------------------------------------------------- |
---|
188 | subroutine get_character(fb,c,iostat) |
---|
189 | character(len=1), intent(out) :: c |
---|
190 | type(file_buffer_t), intent(inout) :: fb |
---|
191 | integer, intent(out) :: iostat |
---|
192 | |
---|
193 | character(len=1) :: c_next |
---|
194 | |
---|
195 | if (.not. fb%connected) then |
---|
196 | iostat = BUFFER_NOT_CONNECTED |
---|
197 | return |
---|
198 | endif |
---|
199 | |
---|
200 | if (fb%pos >= fb%nchars) then |
---|
201 | call fill_buffer(fb,iostat) |
---|
202 | if (iostat /= 0) return |
---|
203 | endif |
---|
204 | fb%pos = fb%pos + 1 |
---|
205 | c = fb%buffer(fb%pos:fb%pos) |
---|
206 | fb%counter = fb%counter + 1 ! Raw counter |
---|
207 | fb%col = fb%col + 1 |
---|
208 | ! |
---|
209 | ! Deal with end-of-line handling on the processor... |
---|
210 | ! |
---|
211 | if (c == char(10)) then |
---|
212 | ! Our own marker for end of line |
---|
213 | fb%line = fb%line + 1 |
---|
214 | fb%col = 0 |
---|
215 | endif |
---|
216 | if (c == char(13)) then |
---|
217 | c_next = fb%buffer(fb%pos+1:fb%pos+1) |
---|
218 | if (c_next == char(10)) then |
---|
219 | ! |
---|
220 | ! Found CRLF. We replace it by LF, as per specs. |
---|
221 | c = c_next |
---|
222 | fb%pos = fb%pos + 1 |
---|
223 | if (fb%debug) print *, "-/-> Removed CR before LF in get_character" |
---|
224 | else |
---|
225 | ! Replace single CR by LF |
---|
226 | c = char(10) |
---|
227 | if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++" |
---|
228 | ! |
---|
229 | endif |
---|
230 | ! In both cases we increase the line counter and reset the column |
---|
231 | ! |
---|
232 | fb%line = fb%line + 1 |
---|
233 | fb%col = 0 |
---|
234 | endif |
---|
235 | |
---|
236 | iostat = 0 |
---|
237 | |
---|
238 | end subroutine get_character |
---|
239 | |
---|
240 | !---------------------------------------------------- |
---|
241 | !---------------------------------------------------- |
---|
242 | ! Error Location functions |
---|
243 | ! |
---|
244 | function line(fb) result (ll) |
---|
245 | type(file_buffer_t), intent(in) :: fb |
---|
246 | integer :: ll |
---|
247 | |
---|
248 | ll = fb%line |
---|
249 | end function line |
---|
250 | |
---|
251 | !---------------------------------------------------- |
---|
252 | function column(fb) result (col) |
---|
253 | type(file_buffer_t), intent(in) :: fb |
---|
254 | integer :: col |
---|
255 | |
---|
256 | col = fb%col |
---|
257 | end function column |
---|
258 | !---------------------------------------------------- |
---|
259 | !---------------------------------------------------- |
---|
260 | function nchars_processed(fb) result (nc) |
---|
261 | type(file_buffer_t), intent(in) :: fb |
---|
262 | integer :: nc |
---|
263 | |
---|
264 | nc = fb%counter |
---|
265 | end function nchars_processed |
---|
266 | !---------------------------------------------------- |
---|
267 | |
---|
268 | subroutine sync_file(fb,iostat) |
---|
269 | type(file_buffer_t), intent(inout) :: fb |
---|
270 | integer, intent(out) :: iostat |
---|
271 | ! |
---|
272 | ! Repositions the file so that it matches with |
---|
273 | ! the stored file_buffer information |
---|
274 | ! |
---|
275 | integer :: target_counter |
---|
276 | character(len=1) :: c |
---|
277 | |
---|
278 | target_counter = fb%counter |
---|
279 | call rewind_file(fb) |
---|
280 | iostat = 0 |
---|
281 | do |
---|
282 | if (fb%counter == target_counter) exit |
---|
283 | call get_character(fb,c,iostat) |
---|
284 | if (iostat /= 0) return |
---|
285 | enddo |
---|
286 | |
---|
287 | end subroutine sync_file |
---|
288 | |
---|
289 | end module m_reader |
---|
290 | |
---|
291 | |
---|
292 | |
---|
293 | |
---|
294 | |
---|
295 | |
---|
296 | |
---|
297 | |
---|
298 | |
---|