! db.f90 module db use iso_fortran_env 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_logged_in_users public :: db_count_logged_in_users public :: db_add_user public :: db_login_user public :: db_logout_user public :: db_move_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_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " & // "x_pos REAL, y_pos REAL, logged_in INTEGER, " & // "created INTEGER);") if (rc /= SQLITE_OK) return end function db_create_users integer function db_add_user(db, username, password, apperance_r, apperance_g, apperance_b, & x_pos, y_pos, logged_in, created) result(rc) !! Adds student to database. type(db_type), intent(inout) :: db character(len=*), intent(in) :: username character(len=*), intent(in) :: password integer(kind=c_int), intent(in) :: apperance_r integer(kind=c_int), intent(in) :: apperance_g integer(kind=c_int), intent(in) :: apperance_b real(kind=c_double), intent(in) :: x_pos real(kind=c_double), intent(in) :: y_pos integer(kind=c_int), intent(in) :: logged_in integer(kind=c_int), intent(in) :: created type(c_ptr) :: stmt ! Insert values through prepared statement. rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " & //"apperance_r, apperance_g, apperance_b, x_pos, y_pos, logged_in, 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_int(stmt, 3, apperance_r) call db_error(rc, 'sqlite3_bind_int()') rc = sqlite3_bind_int(stmt, 4, apperance_g) call db_error(rc, 'sqlite3_bind_int()') rc = sqlite3_bind_int(stmt, 5, apperance_b) call db_error(rc, 'sqlite3_bind_int()') rc = sqlite3_bind_double(stmt, 6, x_pos) call db_error(rc, 'sqlite3_bind_double()') rc = sqlite3_bind_double(stmt, 7, y_pos) call db_error(rc, 'sqlite3_bind_double()') rc = sqlite3_bind_int(stmt, 8, logged_in) call db_error(rc, 'sqlite3_bind_int()') rc = sqlite3_bind_int(stmt, 9, created) call db_error(rc, 'sqlite3_bind_int()') ! 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_user integer function db_delete_user(db, username) result(rc) !! Adds student to database. type(db_type), intent(inout) :: db character(len=*), intent(in) :: username type(c_ptr) :: stmt ! Insert values through prepared statement. rc = sqlite3_prepare_v2(db%ptr, "DELETE FROM users WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_prepare_v2()') rc = sqlite3_bind_text(stmt, 1, username) call db_error(rc, 'sqlite3_bind_text()') ! 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_delete_user integer function db_count_logged_in_users(db) result(rc) !! Prints number of courses per student to standard output. type(db_type), intent(inout) :: db type(c_ptr) :: stmt integer :: count rc = sqlite3_prepare_v2(db%ptr, "SELECT count(logged_in) FROM users u WHERE u.logged_in = 1;", stmt) call db_error(rc, 'sqlite3_prepare_v2()') step_loop: do rc = sqlite3_step(stmt) select case (rc) case (SQLITE_ROW) count = sqlite3_column_int(stmt, 0) write(output_unit, "(i0)") count 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_count_logged_in_users integer function db_get_logged_in_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 integer :: apperance_r, apperance_g, apperance_b real :: x_pos, y_pos rc = sqlite3_prepare_v2(db%ptr, & "SELECT username, apperance_r, apperance_g, apperance_b, x_pos, y_pos " // & "FROM users u WHERE u.logged_in = 1;", 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) apperance_r = sqlite3_column_int(stmt, 1) apperance_g = sqlite3_column_int(stmt, 2) apperance_b = sqlite3_column_int(stmt, 3) x_pos = sqlite3_column_double(stmt, 4) y_pos = sqlite3_column_double(stmt, 5) write(output_unit, "(a24, i3, i3, i3, f8.2, f8.2)") username(:Len_Trim(username)), & apperance_r, apperance_g, apperance_b, x_pos, y_pos 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_logged_in_users integer function db_login_user(db, username) result(rc) type(db_type), intent(inout) :: db character(len=24), intent(in) :: username type(c_ptr) :: stmt rc = sqlite3_prepare_v2(db%ptr, & "UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_prepare_v2()') rc = sqlite3_bind_text(stmt, 1, username) call db_error(rc, 'sqlite3_bind_text()') rc = sqlite3_step(stmt) call db_error(rc, 'sqlite3_step()') rc = sqlite3_finalize(stmt) call db_error(rc, 'sqlite3_finalize()') end function db_login_user integer function db_logout_user(db, username) result(rc) type(db_type), intent(inout) :: db character(len=24), intent(in) :: username type(c_ptr) :: stmt rc = sqlite3_prepare_v2(db%ptr, & "UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_prepare_v2()') rc = sqlite3_bind_text(stmt, 1, username) call db_error(rc, 'sqlite3_bind_text()') rc = sqlite3_step(stmt) call db_error(rc, 'sqlite3_step()') rc = sqlite3_finalize(stmt) call db_error(rc, 'sqlite3_finalize()') end function db_logout_user integer function db_move_user(db, username, x_pos, y_pos) result(rc) type(db_type), intent(inout) :: db character(len=24), intent(in) :: username real(kind=c_double), intent(in) :: x_pos real(kind=c_double), intent(in) :: y_pos type(c_ptr) :: stmt rc = sqlite3_prepare_v2(db%ptr, & "UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_prepare_v2()') rc = sqlite3_bind_double(stmt, 1, x_pos) call db_error(rc, 'sqlite3_bind_double()') rc = sqlite3_bind_double(stmt, 2, y_pos) call db_error(rc, 'sqlite3_bind_double()') rc = sqlite3_bind_text(stmt, 3, username) call db_error(rc, 'sqlite3_bind_text()') rc = sqlite3_step(stmt) call db_error(rc, 'sqlite3_step()') rc = sqlite3_finalize(stmt) call db_error(rc, 'sqlite3_finalize()') end function db_move_user 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 write(12, '(a, ": ", a, " (", i0, ")")') proc, err_msg, code return end if if (present(proc)) then write(12, '(a, ": ", i0)') proc, code return end if write(12, '("unknown error: ", i0)') code end subroutine db_error end module db