add json module

This commit is contained in:
zongor 2023-10-10 23:49:28 -04:00
parent b0c551bd07
commit 0b09e0ab60
11 changed files with 134 additions and 84 deletions

1
.gitignore vendored
View File

@ -7,4 +7,3 @@ a.out
*.*~ *.*~
build/ build/
fortran/client/client

Binary file not shown.

View File

@ -17,3 +17,4 @@ implicit-typing = false
implicit-external = false implicit-external = false
source-form = "free" source-form = "free"
[dependencies] [dependencies]
json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" }

View File

@ -2,6 +2,7 @@ module player_mod
use iso_fortran_env use iso_fortran_env
use iso_c_binding use iso_c_binding
use raylib use raylib
use json_module
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
suffix_attach suffix_attach
implicit none implicit none
@ -90,28 +91,59 @@ contains
character(len=256) :: f_message character(len=256) :: f_message
character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
type(json_value), pointer :: root, user
type(json_file) :: json
character(len=:), allocatable :: str
character(len=255) :: jsn_string
character(len=10) :: i_str
logical :: found
rc = ipaddr_remote(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4, -1_c_int64_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 = tcp_connect(addr, -1_c_int64_t)
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t) connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
write (f_message, "(f8.2, f8.2, i3, a24)") & call json%initialize()
this%position%x, this%position%y, request_type, this%username call json%create_object(root, '')
call json%create_object(user, 'user')
print *, f_c_string(f_message, .true.) call json%add(user, 'username', this%username)
call json%add(user, 'x_pos', this%position%x)
call json%add(user, 'y_pos', this%position%y)
call json%add(user, 'command', request_type)
rc = msend(connection, f_c_string(f_message, .true.), & call json%add(root, user)
transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t) call json%serialize(root, str)
rc = msend(connection, f_c_string(str, .true.), &
transfer(Len_Trim(f_c_string(str, .true.)), 0_c_size_t), -1_c_int64_t)
call json%destroy()
call json%initialize()
message_size = mrecv(connection, message, msglen, -1_c_int64_t) message_size = mrecv(connection, message, msglen, -1_c_int64_t)
print *, 'recv message: ', message(:message_size) print *, 'recv message: ', message
read (message(:message_size), '(i3)') count
call c_f_string(message, jsn_string)
call json%deserialize(jsn_string(:Len_Trim(jsn_string)))
call json%info('/users', n_children=count)
print *, count print *, count
do i = 0, count, 1 do i = 0, count - 1
message_size = mrecv(connection, message, msglen, -1_c_int64_t) write (i_str, fmt='(I10)') i
i_str = adjustl(i_str)
read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") & call json%get("/users/"//istr//"/apperance_r", apperance_r, found)
apperance_r, apperance_g, apperance_b, x_pos, y_pos, username if (.not. found) stop 1
call json%get("/users/"//istr//"/apperance_g", apperance_g, found)
if (.not. found) stop 1
call json%get("/users/"//istr//"/apperance_b", apperance_b, found)
if (.not. found) stop 1
call json%get("/users/"//istr//"/x_pos", x_pos, found)
if (.not. found) stop 1
call json%get("/users/"//istr//"/y_pos", y_pos, found)
if (.not. found) stop 1
call json%get("/users/"//istr//"/username", username, found)
if (.not. found) stop 1
if (allocated(players)) then if (allocated(players)) then
players = [players, player(username, vector3(x_pos, 1.0_c_float, y_pos), & players = [players, player(username, vector3(x_pos, 1.0_c_float, y_pos), &
@ -121,6 +153,8 @@ contains
color(apperance_r, apperance_g, apperance_b, 255))] color(apperance_r, apperance_g, apperance_b, 255))]
end if end if
end do end do
call json%destroy()
end function send_packet end function send_packet
! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12` ! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12`
@ -146,4 +180,16 @@ contains
end block end block
end function end function
subroutine c_f_string(c_string, f_string)
character(kind=c_char), dimension(:), intent(in) :: c_string
character(len=*), intent(out) :: f_string
integer :: i
i = 1
do while (c_string(i) /= c_null_char .and. i <= len(f_string) - 1)
f_string(i:i) = c_string(i)
i = i + 1
end do
if (i < len(f_string)) f_string(i:) = ' '
end subroutine c_f_string
end module player_mod end module player_mod

Binary file not shown.

View File

@ -1,28 +1,33 @@
program main program main
use iso_fortran_env use iso_fortran_env
use iso_c_binding, only: c_char, c_double, c_int, c_int64_t, c_null_char, & use iso_c_binding
c_size_t, c_carriage_return, c_new_line
use mod_dill, only: ipaddr, ipaddr_local, ipaddr_port, ipaddr_str, & use mod_dill, only: ipaddr, ipaddr_local, ipaddr_port, ipaddr_str, &
IPADDR_MAXSTRLEN, IPADDR_IPV4, tcp_accept, tcp_close, & IPADDR_MAXSTRLEN, IPADDR_IPV4, tcp_accept, tcp_close, &
tcp_listen, mrecv, msend, suffix_attach, suffix_detach tcp_listen, mrecv, msend, suffix_attach, suffix_detach
use json_module
use db use db
implicit none implicit none
type(db_type) :: db type(db_type) :: db
character(len=128):: db_path character(len=128):: db_path
character(len=24):: username character(len=:), allocatable :: username
real(kind=c_double) :: x_pos real(real64) :: x_pos
real(kind=c_double) :: y_pos real(real64) :: y_pos
integer :: command integer :: command
logical :: exist logical :: exist, found
integer(c_int) :: connection, rc, socket integer(c_int) :: connection, rc, socket
integer(c_size_t) :: message_size, msglen = 256 integer(c_size_t) :: message_size, msglen = 256
character(c_char) :: message(256) = '' character(c_char) :: message(255) = ''
type(ipaddr) :: addr, addr_remote type(ipaddr) :: addr, addr_remote
character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = '' character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = ''
character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
type(json_value), pointer :: root
type(json_file) :: json
character(len=:), allocatable :: str
character(len=255) :: jsn_string
call getarg(1, db_path) call getarg(1, db_path)
inquire (file=db_path(:Len_Trim(db_path)), exist=exist) inquire (file=db_path(:Len_Trim(db_path)), exist=exist)
@ -50,25 +55,33 @@ program main
print *, 'New connection from '//trim(address_string) print *, 'New connection from '//trim(address_string)
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t) connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
message_size = mrecv(connection, message, msglen, -1_c_int64_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 call c_f_string(message, jsn_string)
print *, 'username=', username, ' x_pos=', x_pos, ' y_pos=', y_pos, ' command=', command
call json%initialize()
call json%deserialize(jsn_string(:Len_Trim(jsn_string)))
call json%print()
call json%get('user.username', username, found)
if (.not. found) print *, 'cant find username!'
call json%get('user.x_pos', x_pos, found)
if (.not. found) print *, 'cant find x_pos!'
call json%get('user.y_pos', y_pos, found)
if (.not. found) print *, 'cant find y_pos!'
call json%get('user.command', command, found)
if (.not. found) print *, 'cant find command!'
call json%destroy()
if (command .eq. 0) then ! get all logged in users and return their positions to client 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) rc = db_get_logged_in_users(db, connection)
else if (command .eq. 1) then else if (command .eq. 1) then
rc = db_login_user(db, username) rc = db_login_user(db, username)
rc = db_count_logged_in_users(db, connection)
rc = db_get_logged_in_users(db, connection) rc = db_get_logged_in_users(db, connection)
else if (command .eq. 3) then ! update new pos to database else if (command .eq. 3) then ! update new pos to database
rc = db_move_user(db, username, x_pos, y_pos) 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) rc = db_get_logged_in_users(db, connection)
else ! (2) if logout update logged_in to database else ! (2) if logout update logged_in to database
rc = db_logout_user(db, username) rc = db_logout_user(db, username)
rc = db_count_logged_in_users(db, connection)
rc = db_get_logged_in_users(db, connection) rc = db_get_logged_in_users(db, connection)
exit server_loop exit server_loop
end if end if
@ -76,4 +89,17 @@ program main
rc = db_close(db) rc = db_close(db)
contains
subroutine c_f_string(c_string, f_string)
character(kind=c_char), dimension(:), intent(in) :: c_string
character(len=*), intent(out) :: f_string
integer :: i
i = 1
do while (c_string(i) /= c_null_char .and. i <= len(f_string) - 1)
f_string(i:i) = c_string(i)
i = i + 1
end do
if (i < len(f_string)) f_string(i:) = ' '
end subroutine c_f_string
end program main end program main

View File

@ -18,3 +18,4 @@ implicit-external = false
source-form = "free" source-form = "free"
[dependencies] [dependencies]
fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" } fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" }
json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" }

View File

@ -2,6 +2,7 @@
module db module db
use iso_fortran_env use iso_fortran_env
use iso_c_binding use iso_c_binding
use json_module
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
suffix_attach suffix_attach
use :: sqlite3 use :: sqlite3
@ -18,7 +19,6 @@ module db
public :: db_open public :: db_open
public :: db_create_users public :: db_create_users
public :: db_get_logged_in_users public :: db_get_logged_in_users
public :: db_count_logged_in_users
public :: db_add_user public :: db_add_user
public :: db_login_user public :: db_login_user
public :: db_logout_user public :: db_logout_user
@ -141,51 +141,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_count_logged_in_users(db, connection) result(rc)
!! Prints number of courses per student to standard output.
type(db_type), intent(inout) :: db
integer(c_int), intent(inout) :: connection
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()')
step_loop: do
rc = sqlite3_step(stmt)
select case (rc)
case (SQLITE_ROW)
count = sqlite3_column_int(stmt, 0)
print *, 'logged in: ', count
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 (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, connection) result(rc) integer function db_get_logged_in_users(db, connection) 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
integer(c_int), intent(inout) :: connection integer(c_int), intent(inout) :: connection
character(len=256) :: message character(len=:), allocatable :: str
type(json_value), pointer :: root, users, user
type(json_core) :: json
type(c_ptr) :: stmt type(c_ptr) :: stmt
character(len=24) :: username character(len=:), allocatable :: username
integer :: apperance_r, apperance_g, apperance_b integer :: apperance_r, apperance_g, apperance_b
real(real64) :: x_pos, y_pos real(real64) :: x_pos, y_pos
@ -194,6 +160,10 @@ contains
"FROM users u WHERE u.logged_in = 1;", stmt) "FROM users u WHERE u.logged_in = 1;", stmt)
call db_error(rc, 'sqlite3_prepare_v2()') call db_error(rc, 'sqlite3_prepare_v2()')
call json%initialize()
call json%create_object(root, '')
call json%create_array(users, 'users')
step_loop: do step_loop: do
rc = sqlite3_step(stmt) rc = sqlite3_step(stmt)
@ -206,11 +176,16 @@ contains
x_pos = sqlite3_column_double(stmt, 4) x_pos = sqlite3_column_double(stmt, 4)
y_pos = sqlite3_column_double(stmt, 5) y_pos = sqlite3_column_double(stmt, 5)
write (message, "(i3, i3, i3, f8.2, f8.2, a24)") & call json%create_object(user, username)
apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username)) call json%add(user, 'apperance_r', apperance_r)
call json%add(user, 'apperance_g', apperance_g)
call json%add(user, 'apperance_b', apperance_b)
call json%add(user, 'x_pos', x_pos)
call json%add(user, 'y_pos', y_pos)
call json%add(user, 'username', username)
call json%add(users, user)
nullify(user) !cleanup
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) case (SQLITE_DONE)
exit step_loop exit step_loop
@ -220,13 +195,20 @@ contains
end select end select
end do step_loop end do step_loop
call json%add(root, users)
call json%serialize(root, str)
rc = msend(connection, f_c_string(str, .true.), &
transfer(Len_Trim(f_c_string(str, .true.)), 0_c_size_t), -1_c_int64_t)
call json%destroy()
rc = sqlite3_finalize(stmt) rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_finalize()')
end function db_get_logged_in_users end function db_get_logged_in_users
integer function db_login_user(db, username) result(rc) integer function db_login_user(db, username) result(rc)
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username character(len=:), allocatable, intent(in) :: username
type(c_ptr) :: stmt type(c_ptr) :: stmt
rc = sqlite3_prepare_v2(db%ptr, & rc = sqlite3_prepare_v2(db%ptr, &
@ -264,9 +246,9 @@ contains
integer function db_move_user(db, username, x_pos, y_pos) result(rc) integer function db_move_user(db, username, x_pos, y_pos) result(rc)
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username character(len=:), allocatable, intent(in) :: username
real(kind=c_double), intent(in) :: x_pos real(c_double), intent(in) :: x_pos
real(kind=c_double), intent(in) :: y_pos real(c_double), intent(in) :: y_pos
type(c_ptr) :: stmt type(c_ptr) :: stmt
rc = sqlite3_prepare_v2(db%ptr, & rc = sqlite3_prepare_v2(db%ptr, &

View File

@ -0,0 +1,2 @@
#!/bin/sh
cat player.json | nc localhost 5555

Binary file not shown.

View File

@ -1,7 +0,0 @@
program main
use iso_fortran_env
implicit none
write(output_unit, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") 0, 'chakr', 0.0, 0.0
end program main