296 lines
10 KiB
Fortran
296 lines
10 KiB
Fortran
! 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)
|
|
|
|
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)
|
|
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)
|
|
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)
|
|
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
|