1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
!> A small RFC 4180 CSV reader.
!>
!> Fortran ships no CSV parser and the batch endpoint needs a real one: a value
!> such as `Rua Um, Dois` arrives double-quoted with `""` escaping, and
!> splitting on commas would silently shift every column after it.
!>
!> Accepts LF and CRLF line endings, a leading UTF-8 byte-order mark, and
!> quoted fields containing commas, quotes and newlines.
module cepis_csv
use cepis_strings, only: string_buffer
implicit none
private
!> One field of one row.
type, public :: csv_field
character(len=:), allocatable :: text
end type csv_field
!> One row of fields.
type, public :: csv_row
type(csv_field), allocatable :: fields(:)
end type csv_row
!> A parsed table. `rows(1)` is the header row when the file has one.
type, public :: csv_table
type(csv_row), allocatable :: rows(:)
contains
!> How many rows, header included. Zero for an empty document.
procedure :: height
!> Index of the header column named `name`, or zero when absent.
procedure :: column
!> The value at `row`, column `name`. The empty string when either the
!> row or the column is missing.
procedure :: cell
end type csv_table
public :: csv_parse
contains
pure function height(self) result(n)
class(csv_table), intent(in) :: self
integer :: n
n = 0
if (allocated(self%rows)) n = size(self%rows)
end function height
pure function column(self, name) result(index)
class(csv_table), intent(in) :: self
character(len=*), intent(in) :: name
integer :: index, i
index = 0
if (self%height() < 1) return
if (.not. allocated(self%rows(1)%fields)) return
do i = 1, size(self%rows(1)%fields)
if (self%rows(1)%fields(i)%text == name) then
index = i
return
end if
end do
end function column
pure function cell(self, row, name) result(text)
class(csv_table), intent(in) :: self
integer, intent(in) :: row
character(len=*), intent(in) :: name
character(len=:), allocatable :: text
integer :: col
text = ''
if (row < 1 .or. row > self%height()) return
col = self%column(name)
if (col == 0) return
if (.not. allocated(self%rows(row)%fields)) return
if (col > size(self%rows(row)%fields)) return
text = self%rows(row)%fields(col)%text
end function cell
!> Parse `text` into a table. `ok` is `.false.` only for an unterminated
!> quoted field, the one malformation that cannot be read past safely.
subroutine csv_parse(text, table, ok, message)
character(len=*), intent(in) :: text
type(csv_table), intent(out) :: table
logical, intent(out) :: ok
character(len=:), allocatable, intent(out) :: message
type(csv_row), allocatable :: rows(:), bigger(:)
type(csv_row) :: current
integer :: pos, count
ok = .true.
message = ''
allocate (rows(16))
count = 0
pos = 1
if (len(text) >= 3) then
if (iachar(text(1:1)) == 239 .and. iachar(text(2:2)) == 187 .and. &
iachar(text(3:3)) == 191) pos = 4
end if
do while (pos <= len(text))
call parse_row(text, pos, current, ok, message)
if (.not. ok) return
if (count >= size(rows)) then
allocate (bigger(2*size(rows)))
bigger(1:count) = rows(1:count)
call move_alloc(bigger, rows)
end if
count = count + 1
rows(count) = current
end do
allocate (table%rows(count))
if (count > 0) table%rows = rows(1:count)
end subroutine csv_parse
subroutine parse_row(text, pos, row, ok, message)
character(len=*), intent(in) :: text
integer, intent(inout) :: pos
type(csv_row), intent(out) :: row
logical, intent(out) :: ok
character(len=:), allocatable, intent(out) :: message
type(csv_field), allocatable :: fields(:), bigger(:)
character(len=:), allocatable :: value
integer :: count
ok = .true.
message = ''
allocate (fields(16))
count = 0
do
call parse_field(text, pos, value, ok, message)
if (.not. ok) return
if (count >= size(fields)) then
allocate (bigger(2*size(fields)))
bigger(1:count) = fields(1:count)
call move_alloc(bigger, fields)
end if
count = count + 1
fields(count)%text = value
if (pos > len(text)) exit
if (text(pos:pos) == ',') then
pos = pos + 1
cycle
end if
if (text(pos:pos) == char(13)) pos = pos + 1
if (pos <= len(text)) then
if (text(pos:pos) == char(10)) pos = pos + 1
end if
exit
end do
allocate (row%fields(count))
row%fields = fields(1:count)
end subroutine parse_row
subroutine parse_field(text, pos, value, ok, message)
character(len=*), intent(in) :: text
integer, intent(inout) :: pos
character(len=:), allocatable, intent(out) :: value
logical, intent(out) :: ok
character(len=:), allocatable, intent(out) :: message
type(string_buffer) :: out
integer :: first
ok = .true.
message = ''
value = ''
if (pos > len(text)) return
if (text(pos:pos) /= '"') then
first = pos
do while (pos <= len(text))
if (text(pos:pos) == ',' .or. text(pos:pos) == char(10) .or. &
text(pos:pos) == char(13)) exit
pos = pos + 1
end do
if (pos > first) value = text(first:pos - 1)
return
end if
pos = pos + 1
do
if (pos > len(text)) then
ok = .false.
message = 'unterminated quoted field'
return
end if
if (text(pos:pos) == '"') then
if (pos + 1 <= len(text)) then
if (text(pos + 1:pos + 1) == '"') then
call out%append('"')
pos = pos + 2
cycle
end if
end if
pos = pos + 1
exit
end if
call out%append(text(pos:pos))
pos = pos + 1
end do
value = out%text()
do while (pos <= len(text))
if (text(pos:pos) == ',' .or. text(pos:pos) == char(10) .or. &
text(pos:pos) == char(13)) exit
pos = pos + 1
end do
end subroutine parse_field
end module cepis_csv
|