Started on server components. Implemented thin, only-necessary sqlite wrapping in Fortran.

1 files changed, 325 insertions, 0 deletions

diff --git a/captain/sqlite.f90 b/captain/sqlite.f90
new file mode 100644
index 0000000..003bd6f
--- /dev/null
+++ b/captain/sqlite.f90
@@ -0,0 +1,325 @@
+module sqlite
+use iso_c_binding
+implicit none
+
+    integer(kind=c_int), parameter::SQLITE_OK = 0
+    integer(kind=c_int), parameter::SQLITE_ERROR = 1
+    integer(kind=c_int), parameter::SQLITE_BUSY = 5
+    integer(kind=c_int), parameter::SQLITE_ROW = 100
+    integer(kind=c_int), parameter::SQLITE_DONE = 101
+
+    integer, parameter::sqlite3_max_free_strings = 32
+
+    interface
+        function c_strlen(p) bind(c, name='strlen')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(kind=c_size_t)::c_strlen
+        end function c_strlen
+        
+        function c_malloc(x) bind(c, name='malloc')
+        use iso_c_binding
+        type(c_ptr)::c_malloc
+        integer(kind=c_size_t), value::x
+        end function c_malloc
+        
+        subroutine c_free(p) bind(c, name='free')
+        use iso_c_binding
+        type(c_ptr), value::p
+        end subroutine c_free
+        
+        function c_strcpy(p1, p2) bind(c, name='strcpy')
+        use iso_c_binding
+        type(c_ptr), value::p1, p2
+        type(c_ptr)::c_strcpy
+        end function c_strcpy
+        
+    end interface
+    
+    ! Wrapping necessary
+    interface
+        function c_sqlite3_open(p,d) bind(c, name='sqlite3_open')
+        use iso_c_binding
+        type(c_ptr), value::p
+        type(c_ptr), intent(out)::d
+        integer(c_int)::c_sqlite3_open
+        end function c_sqlite3_open
+        
+        function c_sqlite3_prepare(db, zsql, n, pstmt, punused) bind(c, name='sqlite3_prepare_v2')
+        use iso_c_binding
+        type(c_ptr), value::db, zsql
+        type(c_ptr), intent(out)::pstmt, punused
+        integer(c_int), value::n
+        integer(c_int)::c_sqlite3_prepare
+        end function c_sqlite3_prepare
+        
+        function c_sqlite3_bind_int(p, i, j) bind(c, name='sqlite3_bind_int')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int), value::i, j
+        integer(c_int)::c_sqlite3_bind_int
+        end function c_sqlite3_bind_int
+        
+        function c_sqlite3_bind_text(p, i, str, j, pfunc) bind(c, name='sqlite3_bind_text')
+        use iso_c_binding
+        type(c_ptr), value::p, str, pfunc
+        integer(c_int), value::i, j
+        integer(c_int)::c_sqlite3_bind_text
+        end function c_sqlite3_bind_text
+        
+        function c_sqlite3_bind_null(p, i) bind(c, name='sqlite3_bind_null')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int), value::i
+        integer(c_int)::c_sqlite3_bind_null
+        end function c_sqlite3_bind_null
+        
+        function c_sqlite3_column_int(p, i) bind(c, name='sqlite3_column_int')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int), value::i
+        integer(c_int)::c_sqlite3_column_int
+        end function c_sqlite3_column_int
+        
+        function c_sqlite3_column_text(p, i) bind(c, name='sqlite3_column_text')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int), value::i
+        type(c_ptr)::c_sqlite3_column_text
+        end function c_sqlite3_column_text
+        
+    end interface
+
+    ! Good to go
+    interface
+        function sqlite3_close(p) bind(c, name='sqlite3_close')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int)::sqlite3_close
+        end function sqlite3_close
+        
+        function sqlite3_finalize(p) bind(c, name='sqlite3_finalize')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int)::sqlite3_finalize
+        end function sqlite3_finalize
+        
+        function sqlite3_step(p) bind(c, name='sqlite3_step')
+        use iso_c_binding
+        type(c_ptr), value::p
+        integer(c_int)::sqlite3_step
+        end function sqlite3_step
+        
+    end interface
+    
+    type :: sqlite3_stmt
+    
+        type(c_ptr)::stmt
+        
+        type(c_ptr), dimension(sqlite3_max_free_strings)::pointers
+        
+        contains
+        
+        procedure::prepare => stmt_prepare
+        procedure::finalize => stmt_finalize
+        procedure::bind_int => stmt_bind_int
+        procedure::bind_text => stmt_bind_text
+        procedure::bind_null => stmt_bind_null
+        procedure::step => stmt_step
+        procedure::step_now => stmt_step_ignore
+        procedure::column_int => stmt_column_int
+        procedure::column_text => stmt_column_text
+        
+    end type
+    
+contains
+
+    function c_string(str)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::c_string
+        character(*), intent(in)::str
+        
+        character(len=:), pointer::src
+        
+        allocate(character(len=len_trim(str)+1) :: src)
+        src = trim(str)//c_null_char
+        
+        c_string = c_malloc(int(len_trim(str)+1, kind=c_size_t))
+        c_string = c_strcpy(c_string, c_loc(src))
+        
+        deallocate(src)
+        
+    end function c_string
+
+    function sqlite3_open(filename, db)
+    implicit none
+    
+        character(*), intent(in)::filename
+        type(c_ptr), intent(out)::db
+        integer::sqlite3_open
+        
+        type(c_ptr)::cstr
+        
+        cstr = c_string(filename)
+        
+        sqlite3_open = c_sqlite3_open(cstr, db)
+        
+        call c_free(cstr)
+    
+    end function sqlite3_open
+    
+    function sqlite3_prepare(db, txt_stmt, stmt)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::db
+        type(c_ptr), intent(out)::stmt
+        character(*), intent(in)::txt_stmt
+        integer::sqlite3_prepare
+        
+        type(c_ptr)::csql, ctail
+        
+        csql = c_string(txt_stmt)
+        
+        sqlite3_prepare = c_sqlite3_prepare(db, csql, len_trim(txt_stmt), stmt, ctail)
+        
+        call c_free(csql)
+    
+    end function sqlite3_prepare
+    
+    subroutine stmt_finalize(self)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        
+        integer::istatus, i
+    
+        istatus = sqlite3_finalize(self%stmt)
+        
+        i = 1
+        do while(c_associated(self%pointers(i)))
+            call c_free(self%pointers(i))
+            i = i + 1
+        end do
+        
+    end subroutine stmt_finalize
+    
+    function stmt_prepare(self, db, txt)
+    use iso_c_binding
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        type(c_ptr)::db
+        character(*), intent(in)::txt
+        integer::stmt_prepare
+        type(c_ptr)::ctail
+        
+        self%pointers = c_null_ptr
+        
+        self%pointers(1) = c_string(txt)
+        
+        stmt_prepare = c_sqlite3_prepare(db, self%pointers(1), len_trim(txt), self%stmt, ctail)
+    
+    end function stmt_prepare
+    
+    function stmt_bind_int(self, i, j)
+    use iso_c_binding
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer::i, j, stmt_bind_int
+        
+        stmt_bind_int = c_sqlite3_bind_int(self%stmt, int(i, c_int), int(j, c_int))
+        
+    end function stmt_bind_int
+    
+    function stmt_bind_text(self, i, text)
+    use iso_c_binding
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer::i, stmt_bind_text
+        character(*), intent(in)::text
+        integer::iptr
+        
+        iptr = 2
+        do while(c_associated(self%pointers(iptr)))
+            iptr = iptr + 1
+        end do
+        
+        self%pointers(iptr) = c_string(text)
+        
+        stmt_bind_text = c_sqlite3_bind_text(self%stmt, int(i, c_int), self%pointers(iptr), &
+                                             int(-1, c_int), c_null_ptr)
+                
+    end function stmt_bind_text
+    
+    function stmt_bind_null(self, i)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer, intent(in)::i
+        integer::stmt_bind_null
+        
+        stmt_bind_null = c_sqlite3_bind_null(self%stmt, int(i, c_int))
+    
+    end function stmt_bind_null
+    
+    function stmt_step(self)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer::stmt_step
+        
+        stmt_step = sqlite3_step(self%stmt)
+        
+    end function stmt_step
+    
+    subroutine stmt_step_ignore(self)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer::ignored
+        
+        ignored = sqlite3_step(self%stmt)
+        
+    end subroutine stmt_step_ignore
+    
+    function stmt_column_int(self, i)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer, intent(in)::i
+        integer::stmt_column_int
+    
+        stmt_column_int = c_sqlite3_column_int(self%stmt, i)
+    
+    end function stmt_column_int
+    
+    subroutine stmt_column_text(self, i, res)
+    implicit none
+    
+        class(sqlite3_stmt), intent(inout)::self
+        integer, intent(in)::i
+        character(*), intent(out)::res
+        
+        character(kind=c_char), dimension(:), pointer::src
+        type(c_ptr)::txtcol
+        integer::n, i_char
+    
+        txtcol = c_sqlite3_column_text(self%stmt, i)
+        res = " "
+        
+        if(c_associated(txtcol)) then
+            n = c_strlen(txtcol)
+            call c_f_pointer(txtcol, src, (/ n /))
+            do i_char=1, min(n, len(res))
+                res(i_char:i_char) = src(i_char)
+            end do
+        end if
+    
+    end subroutine stmt_column_text
+    
+end module sqlite
\ No newline at end of file