diff --git a/.gitignore b/.gitignore index e943571..9fa917e 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,8 @@ a.out *.mod *.log +*.~undo-tree~ +*.*~ build/ fortran/client/client diff --git a/common/sql/test.db3 b/common/sql/test.db3 index ad367f9..5d766a5 100644 Binary files a/common/sql/test.db3 and b/common/sql/test.db3 differ diff --git a/fortran/client/app/main.f90 b/fortran/client/app/main.f90 index ac996b7..f36774d 100644 --- a/fortran/client/app/main.f90 +++ b/fortran/client/app/main.f90 @@ -27,7 +27,7 @@ program main call getarg(2, password) me = player(username, vector3( 0.0_c_float, 1.0_c_float, 2.0_c_float ), PURPLE) - !players = me%login(password) + players = me%login(password) camera%position = vector3(0.0_c_float, 10.0_c_float, 10.0_c_float) !Camera position camera%target = vector3(0.0_c_float, 0.0_c_float, 0.0_c_float) !Camera looking at point @@ -58,9 +58,9 @@ program main call me%sync_camera(camera) if (player_updated) then - !players = me%move() + players = me%move() else - !players = me%ping() + players = me%ping() end if call begin_drawing() @@ -71,15 +71,15 @@ program main call draw_grid(30_c_int, 1.0_c_float) call draw_cube(me%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, me%apperance) - !do i=1,size(players) - ! call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance) - !end do + do i=1,size(players) + call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance) + end do call end_mode_3d() call end_drawing() end do - !players = me%logout() + players = me%logout() if (allocated(players)) then deallocate(players) end if diff --git a/fortran/client/fpm.toml b/fortran/client/fpm.toml index c7e5650..508f25a 100644 --- a/fortran/client/fpm.toml +++ b/fortran/client/fpm.toml @@ -16,3 +16,4 @@ library = false implicit-typing = false implicit-external = false source-form = "free" +[dependencies] \ No newline at end of file diff --git a/fortran/client/src/player.f90 b/fortran/client/src/player.f90 index 05fb28d..d479e2f 100644 --- a/fortran/client/src/player.f90 +++ b/fortran/client/src/player.f90 @@ -1,67 +1,69 @@ module player_mod - use iso_fortran_env - use iso_c_binding - use raylib - use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & - suffix_attach - implicit none + use iso_fortran_env + use iso_c_binding + use raylib + use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & + suffix_attach + implicit none - type player - character(len=24):: username - type(vector3) :: position - type(color) :: apperance - contains - procedure, public :: login - procedure, public :: logout - procedure, public :: ping - procedure, public :: move - procedure, non_overridable, public :: sync_camera - end type player + type player + character(len=24):: username + type(vector3) :: position + type(color) :: apperance + contains + procedure, public :: login + procedure, public :: logout + procedure, public :: ping + procedure, public :: move + procedure, non_overridable, public :: sync_camera + end type player contains - type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this) - character(24) :: username - type(vector3) :: position - type(color) :: apperance - integer :: fifo_write - integer :: fifo_read + type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this) + character(24) :: username + type(vector3) :: position + type(color) :: apperance + integer :: fifo_write + integer :: fifo_read - this%username = username - this%position = position - this%apperance = apperance - end function + this%username = username + this%position = position + this%apperance = apperance + end function - function login(this, password) result(players) - class(player) :: this - character(24) :: password - type(player), dimension(:), allocatable :: players + function login(this, password) result(players) + class(player) :: this + character(24) :: password + type(player), dimension(:), allocatable :: players - players = send_packet(this, 1) - end function login + print *, password - function logout(this) result(players) - class(player) :: this - type(player), dimension(:), allocatable :: players + players = send_packet(this, 1) + end function login - players = send_packet(this, 2) - end function logout + function logout(this) result(players) + class(player) :: this + type(player), dimension(:), allocatable :: players - function ping(this) result(players) - class(player) :: this - type(player), dimension(:), allocatable :: players + players = send_packet(this, 2) + end function logout - players = send_packet(this, 0) - end function ping + function ping(this) result(players) + class(player) :: this + type(player), dimension(:), allocatable :: players - function move(this) result(players) - class(player) :: this - type(player), dimension(:), allocatable :: players + players = send_packet(this, 0) + end function ping - players = send_packet(this, 3) - end function move + function move(this) result(players) + class(player) :: this + type(player), dimension(:), allocatable :: players - subroutine sync_camera(this, camera) + players = send_packet(this, 3) + end function move + + subroutine sync_camera(this, camera) class(player), intent(inout) :: this type(camera3d), intent(inout) :: camera @@ -71,47 +73,77 @@ contains camera%target%x = this%position%x camera%target%y = this%position%y camera%target%z = this%position%z - end subroutine sync_camera + end subroutine sync_camera - function send_packet(this, request_type) result(players) - class(player) :: this - type(player), dimension(:), allocatable :: players - integer :: request_type - character(len=24) :: username - integer :: apperance_r, apperance_g, apperance_b, i, count - real(c_float) :: x_pos, y_pos + function send_packet(this, request_type) result(players) + class(player) :: this + type(player), dimension(:), allocatable :: players + integer :: request_type + character(len=24) :: username + integer :: apperance_r, apperance_g, apperance_b, i, count + real(c_float) :: x_pos, y_pos - integer(c_int) :: rc, connection - integer(c_size_t) :: message_size, msglen = 256 - type(ipaddr) :: addr - character(c_char) :: message(256) = '' - character(len=*), parameter :: TCP_SUFFIX = c_carriage_return // c_new_line // c_null_char + integer(c_int) :: rc, connection + integer(c_size_t) :: message_size, msglen = 256 + type(ipaddr) :: addr + character(c_char) :: message(256) = '' + character(len=256) :: f_message + character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char - rc = ipaddr_remote(addr, '127.0.0.1' // c_null_char, 35565_c_int, IPADDR_IPV4, -1_c_int64_t) - connection = tcp_connect(addr, -1_c_int64_t) - connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t) + rc = ipaddr_remote(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4, -1_c_int64_t) + connection = tcp_connect(addr, -1_c_int64_t) + connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t) - write(message, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") request_type, & - this%username, this%position%x, this%position%y + write (f_message, "(f8.2, f8.2, i3, a24)") & + this%position%x, this%position%y, request_type, this%username - rc = msend(connection, message(Len_Trim(message)), transfer(Len_Trim(message), 0_c_size_t), -1_c_int64_t) + print *, f_c_string(f_message, .true.) - message_size = mrecv(connection, message, msglen, -1_c_int64_t) - read (message(:message_size), '(i3)') count - do i=0, count, 1 - message_size = mrecv(connection, message, msglen, -1_c_int64_t) + rc = msend(connection, f_c_string(f_message, .true.), & + transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t) - read(message, "(a, i3, i3, i3, f8.2, f8.2)") username, & - apperance_r, apperance_g, apperance_b, x_pos, y_pos + message_size = mrecv(connection, message, msglen, -1_c_int64_t) + print *, 'recv message: ', message(:message_size) + read (message(:message_size), '(i3)') count - if (allocated(players)) then - players = [players, player(username, vector3( x_pos, 1.0_c_float, y_pos ), & - color(apperance_r, apperance_g, apperance_b, 255))] - else - players = [player(username, vector3( x_pos, 1.0_c_float, y_pos ), & - color(apperance_r, apperance_g, apperance_b, 255))] - end if - end do + print *, count + do i = 0, count, 1 + message_size = mrecv(connection, message, msglen, -1_c_int64_t) + + read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") & + apperance_r, apperance_g, apperance_b, x_pos, y_pos, username + + if (allocated(players)) then + players = [players, player(username, vector3(x_pos, 1.0_c_float, y_pos), & + color(apperance_r, apperance_g, apperance_b, 255))] + else + players = [player(username, vector3(x_pos, 1.0_c_float, y_pos), & + color(apperance_r, apperance_g, apperance_b, 255))] + end if + end do end function send_packet + ! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12` + function f_c_string(string, trim) + use, intrinsic :: iso_c_binding, only: c_char, c_null_char + implicit none + character(len=*), intent(in) :: string + logical, intent(in), optional :: trim + + character(kind=c_char, len=:), allocatable :: f_c_string + logical :: trim_ + + trim_ = .true. + if (present(trim)) trim_ = trim + + block + intrinsic trim + if (trim_) then + f_c_string = trim(string)//c_null_char + else + f_c_string = string//c_null_char + end if + end block + end function + end module player_mod diff --git a/fortran/server/.test.sh.swp b/fortran/server/.test.sh.swp new file mode 100644 index 0000000..f528278 Binary files /dev/null and b/fortran/server/.test.sh.swp differ diff --git a/fortran/server/app/main.f90 b/fortran/server/app/main.f90 index 8e7ba81..27cf5e1 100644 --- a/fortran/server/app/main.f90 +++ b/fortran/server/app/main.f90 @@ -1,6 +1,10 @@ program main use iso_fortran_env - use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_char, c_double, c_int, c_int64_t, c_null_char, & + c_size_t, c_carriage_return, c_new_line + use mod_dill, only: ipaddr, ipaddr_local, ipaddr_port, ipaddr_str, & + IPADDR_MAXSTRLEN, IPADDR_IPV4, tcp_accept, tcp_close, & + tcp_listen, mrecv, msend, suffix_attach, suffix_detach use db implicit none @@ -9,15 +13,15 @@ program main character(len=24):: username real(kind=c_double) :: x_pos real(kind=c_double) :: y_pos - integer :: command, rc + integer :: command logical :: exist - inquire (file="debug.log", exist=exist) - if (exist) then - open (12, file="debug.log", status="old", position="append", action="write") - else - open (12, file="debug.log", status="new", action="write") - end if + integer(c_int) :: connection, rc, socket + integer(c_size_t) :: message_size, msglen = 256 + character(c_char) :: message(256) = '' + type(ipaddr) :: addr, addr_remote + character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = '' + character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char call getarg(1, db_path) @@ -26,35 +30,50 @@ program main stop 1 end if - rc = db_open(db, db_path(:Len_Trim(db_path))) - ! do while not logged out - server_loop: do + rc = db_open(db, db_path(:Len_Trim(db_path))) - ! read message from stdin - read(input_unit, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos - write(12, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos - call flush(12) + rc = ipaddr_local(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4) + call ipaddr_str(addr, address_string) - if (command .eq. 0) then ! get all logged in users and return their positions to client - rc = db_count_logged_in_users(db) - rc = db_get_logged_in_users(db) - else if (command .eq. 1) then - rc = db_login_user(db, username) - rc = db_count_logged_in_users(db) - rc = db_get_logged_in_users(db) - else if (command .eq. 3) then ! update new pos to database - rc = db_move_user(db, username, x_pos, y_pos) - rc = db_count_logged_in_users(db) - rc = db_get_logged_in_users(db) - else ! (2) if logout update logged_in to database - rc = db_logout_user(db, username) - rc = db_count_logged_in_users(db) - rc = db_get_logged_in_users(db) - exit server_loop - end if - end do server_loop + print *, 'Listening on socket:' + print *, ' IP address: ', address_string + print *, ' Port: ', ipaddr_port(addr) + print *, ' Opened DB : ', db_path(:Len_Trim(db_path)) - rc = db_close(db) - close(12) + socket = tcp_listen(addr, 0_c_int) + + ! do while not logged out + server_loop: do + + connection = tcp_accept(socket, addr_remote, -1_c_int64_t) + call ipaddr_str(addr, address_string) + print *, 'New connection from '//trim(address_string) + connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t) + message_size = mrecv(connection, message, msglen, -1_c_int64_t) + print *, message_size, message + + read (message, "(f8.2, f8.2, i3, a24)") x_pos, y_pos, command, username + print *, 'username=', username, ' x_pos=', x_pos, ' y_pos=', y_pos, ' command=', command + + if (command .eq. 0) then ! get all logged in users and return their positions to client + rc = db_count_logged_in_users(db, connection) + rc = db_get_logged_in_users(db, connection) + else if (command .eq. 1) then + rc = db_login_user(db, username) + rc = db_count_logged_in_users(db, connection) + rc = db_get_logged_in_users(db, connection) + else if (command .eq. 3) then ! update new pos to database + rc = db_move_user(db, username, x_pos, y_pos) + rc = db_count_logged_in_users(db, connection) + rc = db_get_logged_in_users(db, connection) + else ! (2) if logout update logged_in to database + rc = db_logout_user(db, username) + rc = db_count_logged_in_users(db, connection) + rc = db_get_logged_in_users(db, connection) + exit server_loop + end if + end do server_loop + + rc = db_close(db) end program main diff --git a/fortran/server/src/db.f90 b/fortran/server/src/db.f90 index dbea6e8..206f29b 100644 --- a/fortran/server/src/db.f90 +++ b/fortran/server/src/db.f90 @@ -1,299 +1,333 @@ ! db.f90 module db - use iso_fortran_env - use, intrinsic :: iso_c_binding - use :: sqlite3 - implicit none - private + use iso_fortran_env + use iso_c_binding + use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & + suffix_attach + use :: sqlite3 + implicit none + private - integer, parameter, public :: DB_OK = SQLITE_OK + integer, parameter, public :: DB_OK = SQLITE_OK - type, public :: db_type - type(c_ptr) :: ptr = c_null_ptr - end type db_type + 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 + 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 + private :: db_error + private :: db_exec contains - - integer function db_open(db, path) result(rc) + integer function db_open(db, path) result(rc) !! Opens database. - type(db_type), intent(inout) :: db - character(len=*), intent(in) :: path + 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 + rc = sqlite3_open(path, db%ptr) + call db_error(rc, 'sqlite3_open()') + end function db_open - integer function db_exec(db, query) result(rc) + 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 + 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 + 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) + integer function db_close(db) result(rc) !! Closes database. - type(db_type), intent(inout) :: db + type(db_type), intent(inout) :: db - rc = sqlite3_close(db%ptr) - call db_error(rc, 'sqlite3_close()') - end function db_close + rc = sqlite3_close(db%ptr) + call db_error(rc, 'sqlite3_close()') + end function db_close - integer function db_create_users(db) result(rc) + integer function db_create_users(db) result(rc) !! Creates database tables. - type(db_type), intent(inout) :: db + 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 + ! 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) + 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 + 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()') + ! 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()') + 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()') + ! 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 + ! 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) + 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 + 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()') + ! 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()') + 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()') + ! 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 + ! 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) + integer function db_count_logged_in_users(db, connection) result(rc) !! Prints number of courses per student to standard output. - type(db_type), intent(inout) :: db + type(db_type), intent(inout) :: db + integer(c_int), intent(inout) :: connection - type(c_ptr) :: stmt - integer :: count + character(len=256) :: message + 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()') + 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) + step_loop: do + rc = sqlite3_step(stmt) - select case (rc) - case (SQLITE_ROW) - count = sqlite3_column_int(stmt, 0) - write(output_unit, "(i0)") count + select case (rc) + case (SQLITE_ROW) + count = sqlite3_column_int(stmt, 0) + print *, 'logged in: ', count - case (SQLITE_DONE) - exit step_loop + write (message, "(i3)") count + rc = msend(connection, f_c_string(message, .true.), & + transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t) - case default - call db_error(rc, 'sqlite3_step()') - exit step_loop - end select - end do step_loop + case (SQLITE_DONE) + exit step_loop - rc = sqlite3_finalize(stmt) - call db_error(rc, 'sqlite3_finalize()') - end function db_count_logged_in_users + case default + call db_error(rc, 'sqlite3_step()') + exit step_loop + end select + end do step_loop - integer function db_get_logged_in_users(db) result(rc) + 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, connection) result(rc) !! Prints number of courses per student to standard output. - type(db_type), intent(inout) :: db + type(db_type), intent(inout) :: db + integer(c_int), intent(inout) :: connection - type(c_ptr) :: stmt - character(len=24) :: username - integer :: apperance_r, apperance_g, apperance_b - real :: x_pos, y_pos + character(len=256) :: message + type(c_ptr) :: stmt + character(len=24) :: username + integer :: apperance_r, apperance_g, apperance_b + real(real64) :: 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()') + 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) + 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, 1x, i3, 1x, i3, 1x, i3, 1x, f8.2, 1x, f8.2)") username(:Len_Trim(username)), & - apperance_r, apperance_g, apperance_b, x_pos, y_pos + 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) - case (SQLITE_DONE) - exit step_loop + write (message, "(i3, i3, i3, f8.2, f8.2, a24)") & + apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username)) - case default - call db_error(rc, 'sqlite3_step()') - exit step_loop - end select - end do step_loop + rc = msend(connection, f_c_string(message, .true.), & + transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t) + case (SQLITE_DONE) + exit 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 + case default + call db_error(rc, 'sqlite3_step()') + exit step_loop + end select + end do step_loop - 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_finalize(stmt) + call db_error(rc, 'sqlite3_finalize()') + end function db_get_logged_in_users - rc = sqlite3_bind_text(stmt, 1, username) - call db_error(rc, 'sqlite3_bind_text()') + 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_step(stmt) - call db_error(rc, 'sqlite3_step()') + 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_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_bind_text(stmt, 1, username) + call db_error(rc, 'sqlite3_bind_text()') - 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_step(stmt) + call db_error(rc, 'sqlite3_step()') - rc = sqlite3_bind_text(stmt, 1, username) - call db_error(rc, 'sqlite3_bind_text()') + rc = sqlite3_finalize(stmt) + call db_error(rc, 'sqlite3_finalize()') + end function db_login_user - rc = sqlite3_step(stmt) - call db_error(rc, 'sqlite3_step()') + 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_finalize(stmt) - call db_error(rc, 'sqlite3_finalize()') - end function db_logout_user + rc = sqlite3_prepare_v2(db%ptr, & + "UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt) + call db_error(rc, 'sqlite3_prepare_v2()') - 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_bind_text(stmt, 1, username) + call db_error(rc, 'sqlite3_bind_text()') - 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_step(stmt) + call db_error(rc, 'sqlite3_step()') - 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_finalize(stmt) + call db_error(rc, 'sqlite3_finalize()') + end function db_logout_user - rc = sqlite3_step(stmt) - call db_error(rc, 'sqlite3_step()') + 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_finalize(stmt) - call db_error(rc, 'sqlite3_finalize()') - end function db_move_user + rc = sqlite3_prepare_v2(db%ptr, & + "UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt) + call db_error(rc, 'sqlite3_prepare_v2()') - subroutine db_error(code, proc, err_msg) + 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 + 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 (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) .and. present(err_msg)) then + print *, proc, err_msg, code + return + end if - if (present(proc)) then - write(12, '(a, ": ", i0)') proc, code - return - end if + if (present(proc)) then + print *, proc, code + return + end if - write(12, '("unknown error: ", i0)') code - end subroutine db_error + print *, 'unknown error: ', code + end subroutine db_error + + ! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12` + function f_c_string(string, trim) + use, intrinsic :: iso_c_binding, only: c_char, c_null_char + implicit none + character(len=*), intent(in) :: string + logical, intent(in), optional :: trim + + character(kind=c_char, len=:), allocatable :: f_c_string + logical :: trim_ + + trim_ = .true. + if (present(trim)) trim_ = trim + + block + intrinsic trim + if (trim_) then + f_c_string = trim(string)//c_null_char + else + f_c_string = string//c_null_char + end if + end block + end function end module db diff --git a/fortran/server/test.sh b/fortran/server/test.sh index 456f531..a361f13 100755 --- a/fortran/server/test.sh +++ b/fortran/server/test.sh @@ -1,2 +1,3 @@ #!/bin/sh -listen1 'tcp!*!35565' ~/.local/bin/fortran-mmo-server ../../common/sql/test.db3 +#listen1 'tcp!*!35565' +~/.local/bin/fortran-mmo-server ../../common/sql/test.db3