update to use new sql stuff
This commit is contained in:
parent
f29fba4f11
commit
cb77591be1
Binary file not shown.
|
@ -1,6 +1,6 @@
|
||||||
# Programming Language Project Fortran Implementation
|
# Programming Language Project Fortran Implementation or, a Fortran CGI program abuses a sqlite3 database to implement a game server
|
||||||
|
|
||||||
[fortran-µhttpd (game website & webserver)](./www-f/README.md)
|
[fortran-µhttpd (game website & webserver)](./www/README.md)
|
||||||
|
|
||||||
server (game backend)
|
server (game backend)
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
program main
|
program main
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
use www
|
use www
|
||||||
use db
|
use db
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -58,6 +59,8 @@ contains
|
||||||
character(len=24) :: username
|
character(len=24) :: username
|
||||||
character(len=24) :: password
|
character(len=24) :: password
|
||||||
character(len=8) :: appearance
|
character(len=8) :: appearance
|
||||||
|
real(kind=c_double) :: x_pos = 0.0_c_double
|
||||||
|
real(kind=c_double) :: y_pos = 0.0_c_double
|
||||||
logical :: start = .false.
|
logical :: start = .false.
|
||||||
|
|
||||||
type(db_type) :: db
|
type(db_type) :: db
|
||||||
|
@ -111,7 +114,8 @@ contains
|
||||||
appearance = transfer(request(s_idx:length), appearance)
|
appearance = transfer(request(s_idx:length), appearance)
|
||||||
|
|
||||||
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
||||||
rc = db_add_user(db, username(:username_len), password(:password_len), appearance(:Len_Trim(appearance)), 0, 0, 0, time())
|
rc = db_add_user(db, username(:username_len), password(:password_len), &
|
||||||
|
appearance(:Len_Trim(appearance)), x_pos, y_pos, 0, time())
|
||||||
rc = db_close(db)
|
rc = db_close(db)
|
||||||
|
|
||||||
end subroutine add_user
|
end subroutine add_user
|
||||||
|
|
|
@ -5,7 +5,6 @@ maintainer = "admin@alfrescocavern.com"
|
||||||
name = "fortran-micro-httpd"
|
name = "fortran-micro-httpd"
|
||||||
version = "0.1.0"
|
version = "0.1.0"
|
||||||
[build]
|
[build]
|
||||||
link = ["pthread", "libdill"]
|
|
||||||
auto-examples = true
|
auto-examples = true
|
||||||
auto-executables = true
|
auto-executables = true
|
||||||
auto-tests = false
|
auto-tests = false
|
||||||
|
|
|
@ -15,7 +15,7 @@ module db
|
||||||
public :: db_close
|
public :: db_close
|
||||||
public :: db_open
|
public :: db_open
|
||||||
public :: db_create_users
|
public :: db_create_users
|
||||||
public :: db_get_users
|
public :: db_get_logged_in_users
|
||||||
public :: db_add_user
|
public :: db_add_user
|
||||||
public :: db_delete_user
|
public :: db_delete_user
|
||||||
|
|
||||||
|
@ -59,27 +59,27 @@ contains
|
||||||
rc = db_exec(db, "CREATE TABLE users " &
|
rc = db_exec(db, "CREATE TABLE users " &
|
||||||
// "(id INTEGER PRIMARY KEY ASC, " &
|
// "(id INTEGER PRIMARY KEY ASC, " &
|
||||||
// "username TEXT, password TEXT, " &
|
// "username TEXT, password TEXT, " &
|
||||||
// "apperance TEXT, x_pos INTEGER, " &
|
// "apperance TEXT, x_pos REAL, " &
|
||||||
// "y_pos INTEGER, last_login INTEGER, " &
|
// "y_pos REAL, logged_in INTEGER, " &
|
||||||
// "created INTEGER);")
|
// "created INTEGER);")
|
||||||
if (rc /= SQLITE_OK) return
|
if (rc /= SQLITE_OK) return
|
||||||
end function db_create_users
|
end function db_create_users
|
||||||
|
|
||||||
integer function db_add_user(db, username, password, apperance, x_pos, y_pos, last_login, created) result(rc)
|
integer function db_add_user(db, username, password, apperance, x_pos, y_pos, logged_in, created) result(rc)
|
||||||
!! Adds student to database.
|
!! Adds student to database.
|
||||||
type(db_type), intent(inout) :: db
|
type(db_type), intent(inout) :: db
|
||||||
character(len=*), intent(in) :: username
|
character(len=*), intent(in) :: username
|
||||||
character(len=*), intent(in) :: password
|
character(len=*), intent(in) :: password
|
||||||
character(len=*), intent(in) :: apperance
|
character(len=*), intent(in) :: apperance
|
||||||
integer, intent(in) :: x_pos
|
real(kind=c_double), intent(in) :: x_pos
|
||||||
integer, intent(in) :: y_pos
|
real(kind=c_double), intent(in) :: y_pos
|
||||||
integer, intent(in) :: last_login
|
integer(kind=c_int), intent(in) :: logged_in
|
||||||
integer, intent(in) :: created
|
integer(kind=c_int), intent(in) :: created
|
||||||
type(c_ptr) :: stmt
|
type(c_ptr) :: stmt
|
||||||
|
|
||||||
! Insert values through prepared statement.
|
! Insert values through prepared statement.
|
||||||
rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " &
|
rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " &
|
||||||
//"apperance, x_pos, y_pos, last_login, created) VALUES (?,?,?,?,?,?,?)", stmt)
|
//"apperance, x_pos, y_pos, logged_in, created) VALUES (?,?,?,?,?,?,?)", stmt)
|
||||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||||
|
|
||||||
rc = sqlite3_bind_text(stmt, 1, username)
|
rc = sqlite3_bind_text(stmt, 1, username)
|
||||||
|
@ -88,11 +88,11 @@ contains
|
||||||
call db_error(rc, 'sqlite3_bind_text()')
|
call db_error(rc, 'sqlite3_bind_text()')
|
||||||
rc = sqlite3_bind_text(stmt, 3, apperance)
|
rc = sqlite3_bind_text(stmt, 3, apperance)
|
||||||
call db_error(rc, 'sqlite3_bind_text()')
|
call db_error(rc, 'sqlite3_bind_text()')
|
||||||
rc = sqlite3_bind_int(stmt, 4, x_pos)
|
rc = sqlite3_bind_double(stmt, 4, x_pos)
|
||||||
call db_error(rc, 'sqlite3_bind_int()')
|
call db_error(rc, 'sqlite3_bind_double()')
|
||||||
rc = sqlite3_bind_int(stmt, 5, y_pos)
|
rc = sqlite3_bind_double(stmt, 5, y_pos)
|
||||||
call db_error(rc, 'sqlite3_bind_int()')
|
call db_error(rc, 'sqlite3_bind_double()')
|
||||||
rc = sqlite3_bind_int(stmt, 6, last_login)
|
rc = sqlite3_bind_int(stmt, 6, logged_in)
|
||||||
call db_error(rc, 'sqlite3_bind_int()')
|
call db_error(rc, 'sqlite3_bind_int()')
|
||||||
rc = sqlite3_bind_int(stmt, 7, created)
|
rc = sqlite3_bind_int(stmt, 7, created)
|
||||||
call db_error(rc, 'sqlite3_bind_int()')
|
call db_error(rc, 'sqlite3_bind_int()')
|
||||||
|
@ -129,17 +129,17 @@ contains
|
||||||
call db_error(rc, 'sqlite3_finalize()')
|
call db_error(rc, 'sqlite3_finalize()')
|
||||||
end function db_delete_user
|
end function db_delete_user
|
||||||
|
|
||||||
integer function db_get_users(db) result(rc)
|
integer function db_get_logged_in_users(db) result(rc)
|
||||||
!! Prints number of courses per student to standard output.
|
!! Prints number of courses per student to standard output.
|
||||||
type(db_type), intent(inout) :: db
|
type(db_type), intent(inout) :: db
|
||||||
|
|
||||||
type(c_ptr) :: stmt
|
type(c_ptr) :: stmt
|
||||||
character(len=24) :: username
|
character(len=24) :: username
|
||||||
character(len=24) :: password
|
real(kind=c_double) :: x_pos, y_pos
|
||||||
|
|
||||||
rc = sqlite3_prepare_v2(db%ptr, &
|
rc = sqlite3_prepare_v2(db%ptr, &
|
||||||
"SELECT username, password " // &
|
"SELECT username, x_pos, y_pos " // &
|
||||||
"FROM users;", stmt)
|
"FROM users u WHERE u.logged_in = 1;", stmt)
|
||||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||||
|
|
||||||
step_loop: do
|
step_loop: do
|
||||||
|
@ -148,8 +148,9 @@ contains
|
||||||
select case (rc)
|
select case (rc)
|
||||||
case (SQLITE_ROW)
|
case (SQLITE_ROW)
|
||||||
username = sqlite3_column_text(stmt, 0)
|
username = sqlite3_column_text(stmt, 0)
|
||||||
password = sqlite3_column_text(stmt, 1)
|
x_pos = sqlite3_column_double(stmt, 1)
|
||||||
write(12, '(a)') username, password
|
y_pos = sqlite3_column_double(stmt, 1)
|
||||||
|
write(12, *) username, x_pos, y_pos
|
||||||
|
|
||||||
case (SQLITE_DONE)
|
case (SQLITE_DONE)
|
||||||
exit step_loop
|
exit step_loop
|
||||||
|
@ -162,7 +163,7 @@ contains
|
||||||
|
|
||||||
rc = sqlite3_finalize(stmt)
|
rc = sqlite3_finalize(stmt)
|
||||||
call db_error(rc, 'sqlite3_finalize()')
|
call db_error(rc, 'sqlite3_finalize()')
|
||||||
end function db_get_users
|
end function db_get_logged_in_users
|
||||||
|
|
||||||
subroutine db_error(code, proc, err_msg)
|
subroutine db_error(code, proc, err_msg)
|
||||||
!! Prints error message.
|
!! Prints error message.
|
||||||
|
|
Loading…
Reference in New Issue