diff options
Diffstat (limited to 'captain/sqlite.f90')
-rw-r--r-- | captain/sqlite.f90 | 325 |
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 |