diff options
Diffstat (limited to 'src/cepis_csv.f90')
| -rw-r--r-- | src/cepis_csv.f90 | 218 |
1 files changed, 218 insertions, 0 deletions
diff --git a/src/cepis_csv.f90 b/src/cepis_csv.f90 new file mode 100644 index 0000000..80502c6 --- /dev/null +++ b/src/cepis_csv.f90 @@ -0,0 +1,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 |