From 4db2ebc0245ce9f4942054a7e6873414805e272c Mon Sep 17 00:00:00 2001 From: Charles Kralapp Date: Tue, 5 Sep 2023 19:20:09 -0400 Subject: [PATCH] add db module --- fortran/www/fpm.toml | 2 + fortran/www/src/db.f90 | 164 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 166 insertions(+) create mode 100644 fortran/www/src/db.f90 diff --git a/fortran/www/fpm.toml b/fortran/www/fpm.toml index 619d2ce..6b2cd6a 100644 --- a/fortran/www/fpm.toml +++ b/fortran/www/fpm.toml @@ -5,6 +5,7 @@ maintainer = "admin@alfrescocavern.com" name = "fortran-micro-httpd" version = "0.1.0" [build] +link = ["pthread", "libdill"] auto-examples = true auto-executables = true auto-tests = false @@ -16,3 +17,4 @@ implicit-external = false implicit-typing = false source-form = "free" [dependencies] +fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" } \ No newline at end of file diff --git a/fortran/www/src/db.f90 b/fortran/www/src/db.f90 new file mode 100644 index 0000000..92406a9 --- /dev/null +++ b/fortran/www/src/db.f90 @@ -0,0 +1,164 @@ +! db.f90 +module db + !! Database abstraction layer. + use, intrinsic :: iso_c_binding + use :: sqlite3 + implicit none + private + + integer, parameter, public :: DB_OK = SQLITE_OK + + type, public :: db_type + type(c_ptr) :: ptr = c_null_ptr + end type db_type + + public :: db_close + public :: db_open + public :: db_create_users + public :: db_get_users + public :: db_add_user + public :: db_delete_user + + private :: db_error + private :: db_exec +contains + + + integer function db_open(db, path) result(rc) + !! Opens database. + type(db_type), intent(inout) :: db + character(len=*), intent(in) :: path + + rc = sqlite3_open(path, db%ptr) + call db_error(rc, 'sqlite3_open()') + end function db_open + + integer function db_exec(db, query) result(rc) + !! Executes SQLite query. + type(db_type), intent(inout) :: db + character(len=*), intent(in) :: query + character(len=:), allocatable :: err_msg + + rc = sqlite3_exec(db%ptr, query, c_null_ptr, c_null_ptr, err_msg) + call db_error(rc, 'sqlite3_exec()', err_msg) + end function db_exec + + integer function db_close(db) result(rc) + !! Closes database. + type(db_type), intent(inout) :: db + + rc = sqlite3_close(db%ptr) + call db_error(rc, 'sqlite3_close()') + end function db_close + + integer function db_create_users(db) result(rc) + !! Creates database tables. + type(db_type), intent(inout) :: db + + ! Create table "users". + rc = db_exec(db, "CREATE TABLE users " & + // "(id INTEGER PRIMARY KEY ASC, " & + // "username TEXT, password TEXT, " & + // "apperance TEXT, x_pos INTEGER, " & + // "y_pos INTEGER, last_login INTEGER, " & + // "created INTEGER);") + if (rc /= SQLITE_OK) return + end function db_create_users + + integer function db_add_user(db, name) result(rc) + !! Adds student to database. + type(db_type), intent(inout) :: db + character(len=:), intent(in) :: username + character(len=:), intent(in) :: password + character(len=:), intent(in) :: apperance + integer, intent(in) :: x_pos + integer, intent(in) :: y_pos + integer, intent(in) :: last_login + integer, intent(in) :: created + type(c_ptr) :: stmt + + ! Insert values through prepared statement. + rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " + //"apperance, x_pos, y_pos, last_login, created) VALUES (?,?,?,?,?,?,?)", stmt) + call db_error(rc, 'sqlite3_prepare_v2()') + + rc = sqlite3_bind_text(stmt, 1, username) + call db_error(rc, 'sqlite3_bind_text()') + rc = sqlite3_bind_text(stmt, 2, password) + call db_error(rc, 'sqlite3_bind_text()') + rc = sqlite3_bind_text(stmt, 3, apperance) + call db_error(rc, 'sqlite3_bind_text()') + rc = sqlite3_bind_integer(stmt, 4, x_pos) + call db_error(rc, 'sqlite3_bind_integer()') + rc = sqlite3_bind_integer(stmt, 5, y_pos) + call db_error(rc, 'sqlite3_bind_integer()') + rc = sqlite3_bind_integer(stmt, 6, last_login) + call db_error(rc, 'sqlite3_bind_integer()') + rc = sqlite3_bind_integer(stmt, 7, created) + call db_error(rc, 'sqlite3_bind_integer()') + + ! Insert bound value into database. + rc = sqlite3_step(stmt) + call db_error(rc, 'sqlite3_step()') + + ! Clean-up prepared statement. + rc = sqlite3_finalize(stmt) + call db_error(rc, 'sqlite3_finalize()') + end function db_add_student + + integer function db_get_users(db) result(rc) + !! Prints number of courses per student to standard output. + type(db_type), intent(inout) :: db + + type(c_ptr) :: stmt + character(len=24) :: username + character(len=24) :: password + + rc = sqlite3_prepare_v2(db%ptr, & + "SELECT username " // & + "FROM users;", stmt) + call db_error(rc, 'sqlite3_prepare_v2()') + + step_loop: do + rc = sqlite3_step(stmt) + + select case (rc) + case (SQLITE_ROW) + username = sqlite3_column_text(stmt, 0) + password = sqlite3_column_text(stmt, 1) + print '(a),(a)', username, password + + case (SQLITE_DONE) + exit step_loop + + case default + call db_error(rc, 'sqlite3_step()') + exit step_loop + end select + end do step_loop + + rc = sqlite3_finalize(stmt) + call db_error(rc, 'sqlite3_finalize()') + end function db_get_users + + subroutine db_error(code, proc, err_msg) + !! Prints error message. + integer, intent(in) :: code + character(len=*), intent(in), optional :: proc + character(len=*), intent(in), optional :: err_msg + + if (code == SQLITE_OK .or. code == SQLITE_DONE) return + + if (present(proc) .and. present(err_msg)) then + print '(a, ": ", a, " (", i0, ")")', proc, err_msg, code + return + end if + + if (present(proc)) then + print '(a, ": ", i0)', proc, code + return + end if + + print '("unknown error: ", i0)', code + end subroutine db_error +end module db