mmo-project/fortran/www/app/main.f90

program main
   use, intrinsic :: iso_c_binding
   use www
   use db
   implicit none

   character, dimension(:), allocatable  :: form_data
   character(len=32) :: index_path
   character(len=128):: db_path
   integer :: err, i, length
   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

   call getarg(1, index_path)
   call getarg(2, db_path)

   call request(form_data, length)

   if (length .gt. 0) then
      inquire (file=db_path(:Len_Trim(db_path)), exist=exist)
      if (.not. exist) then
         call create_db(db_path)
      end if

      call add_user(db_path, form_data, length)
   end if

   call write_index(index_path)

   if (allocated(form_data)) deallocate (form_data, stat=err)
   if (err /= 0) print *, "index_html: Deallocation request denied"

   close (unit=12)
contains

   subroutine create_db(db_path)
      character(len=128), intent(in) :: db_path
      type(db_type) :: db
      integer :: rc

      rc = db_open(db, db_path(:Len_Trim(db_path)))
      rc = db_create_users(db)
      rc = db_close(db)

   end subroutine create_db

   subroutine add_user(db_path, request, length)
      character(len=128), intent(in) :: db_path
      character, dimension(:), allocatable, intent(in) :: request
      integer, intent(in) :: length

      integer :: i, j, s_idx, e_idx, username_len, password_len
      character(len=24) :: username
      character(len=24) :: password
      integer :: appearance_r, appearance_g, appearance_b
      real(kind=c_double) :: x_pos = 0.0_c_double
      real(kind=c_double) :: y_pos = 0.0_c_double
      logical :: start = .false.

      type(db_type) :: db
      integer :: rc

      j = 1
      get_username: do i = 1, length
         if (request(i) .eq. '=') then
            s_idx = i + 1
            start = .true.
         end if

         if (request(i) .eq. '&') then
            e_idx = i - 1
            start = .false.
            exit get_username
         end if

         if (start) then
            username(j:j) = request(i + 1)
            j = j + 1
         end if
      end do get_username
      username_len = j - 2

      j = 1
      get_password: do i = e_idx + 2, length
         if (request(i) .eq. '=') then
            s_idx = i + 1
            start = .true.
         end if

         if (request(i) .eq. '&') then
            e_idx = i - 1
            start = .false.
            exit get_password
         end if

         if (start) then
            password(j:j) = request(i + 1)
            j = j + 1
         end if
      end do get_password
      password_len = j - 2

      get_appearance: do i = e_idx + 2, length
         if (request(i) .eq. '=') then
            s_idx = i + 4            
         end if
      end do get_appearance

      appearance_r = hex2int(request(s_idx), request(s_idx+1))
      appearance_g = hex2int(request(s_idx+2), request(s_idx+3))
      appearance_b = hex2int(request(s_idx+4), request(s_idx+5))

      rc = db_open(db, db_path(:Len_Trim(db_path)))
      rc = db_add_user(db, username(:username_len), password(:password_len), &
         appearance_r, appearance_g, appearance_b, x_pos, y_pos, 0, time())
      rc = db_close(db)

   end subroutine add_user

   integer function hex2int(h1, h2) result(val)
        character, intent(in) :: h1
        character, intent(in) :: h2
        integer :: a, b

        if (ichar(h1) .le. ichar('9')) then 
         a = ichar(h1) - ichar('0')
        else
         a = iand(ichar(h1), 7) + 9
        end if

        if (ichar(h2) .le. ichar('9')) then 
         b = ichar(h2) - ichar('0')
        else
         b = iand(ichar(h2), 7) + 9
        end if

        val = shiftl(a, 4) + b
   end function hex2int
  
end program main