Initial import

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