mmo-project/fortran/www/src/db.f90

! 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