From af084b8acb5ed7e883e422c4626a596eb32fba25 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 1 Apr 2021 11:38:06 -0400 Subject: Added support for viewing individual instruction pages, assigning players, and launching instruction jobs --- captain/external.f90 | 307 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 302 insertions(+), 5 deletions(-) (limited to 'captain/external.f90') diff --git a/captain/external.f90 b/captain/external.f90 index 1a27be0..ee4d2e6 100644 --- a/captain/external.f90 +++ b/captain/external.f90 @@ -3,15 +3,112 @@ implicit none contains - function generate_jobs_gemini() result(res) + pure function get_status_utf8(status) result(res) use captain_db implicit none + integer, intent(in)::status + character(4)::res + + select case(status) + + case(JOB_STATUS_SUCCESS) + ! Check mark 0x2714 + res = char(226)//char(156)//char(148)//" " + + case(JOB_STATUS_FAILURE) + ! Ballot x 0x2717 + res = char(226)//char(156)//char(151)//" " + + case(JOB_STATUS_WORKING) + ! Runner 0x1f3c3 + res = char(240)//char(159)//char(143)//char(131) + + case(PLAYER_STATUS_IDLE) + ! Sleeping 0x1f4a4 + res = char(240)//char(159)//char(146)//char(164) + + end select + + end function get_status_utf8 + + function render_jobs_links(jobs, startindex, stopindex) result(res) + use captain_db + implicit none + + type(job), dimension(:), pointer, intent(in)::jobs + integer, intent(in), optional::startindex, stopindex + character(len=:), pointer::res + + integer::nsize, i, first, last + character(len=16)::int_text + character(len=(2*PLAYER_NAME_LENGTH + 64))::link + character(PLAYER_NAME_LENGTH)::player, instruction + character(1)::nl = new_line(' ') + + if(.not. associated(jobs)) then + allocate(character(len=32)::res) + res = "None Yet" + + else + first = 1 + if(present(startindex)) then + first = startindex + end if + + last = size(jobs) + if(present(stopindex)) then + last = min(size(jobs), stopindex) + end if + + if(first < last .and. first < size(jobs)) then + nsize = (last-first+1)*(2*PLAYER_NAME_LENGTH + 64) + allocate(character(len=nsize) :: res) + res = " " + + do i = first, last + call get_instruction_name(jobs(i)%instruction, instruction) + call get_player_name(jobs(i)%player, player) + + write(int_text, '(I8)') jobs(i)%id + link = "=> jobs/"//trim(adjustl(int_text))//".gmi"// & + trim(get_status_utf8(jobs(i)%status))//" Job "// & + trim(adjustl(int_text))//" - "//trim(instruction) + + res = trim(res)//nl//nl//link + + res = trim(res)//nl//"Running on "//trim(player)// & + " - Last Update: "//trim(jobs(i)%time) + end do + + else + + ! Indices exceed array + allocate(character(len=64)::res) + write(int_text, '(I8)') first + res = "None at index "//trim(adjustl(int_text))//" or beyond" + + end if + end if + + end function render_jobs_links + + function generate_jobs_gemini(req) result(res) + use captain_db + use server_response + implicit none + + type(request)::req character(len=:), pointer::res type(job), dimension(:), pointer::jobs integer::n, i, nsize + integer::i_start_jobs, ierr - n = get_player_count() + character(len=:), pointer::linklist + character(16)::int_text, int_text2 + + + n = get_jobs_count() if(n == 0) then allocate(character(len=1024) :: res) @@ -19,6 +116,27 @@ contains res = "None Yet" else + if(associated(req%query_string)) then + read(req%query_string, *, iostat=ierr) i_start_jobs + else + ierr = -1 + end if + + if(ierr /= 0) then + i_start_jobs = 1 + end if + + jobs => get_jobs() + + ! 15 per page + nsize = 15*(2*PLAYER_NAME_LENGTH + 64) + 1024 + allocate(character(len=nsize) :: res) + + res = "## Jobs " + + linklist => render_jobs_links(jobs, i_start_jobs, min(i_start_jobs+14, n)) + res = res//trim(linklist) + deallocate(linklist) end if @@ -70,6 +188,150 @@ contains end function generate_players_gemini + function generate_one_instuction_gemini(req) result(res) + use captain_db + use server_response + implicit none + + type(request)::req + character(len=:), pointer::res + integer::id_from_req + + character(128)::instruction_name + type(job), dimension(:), pointer::jobs + integer, dimension(:), pointer::players + character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::all_players + integer::i, j, n_jobs, n_players, nsize + + character(len=:), pointer::job_link_text, player_link_text + character(1)::nl = new_line(' ') + character(PLAYER_NAME_LENGTH)::player_name + character(4)::player_status + + i = index(req%location, "/", back=.true.) + j = index(req%location, ".", back=.true.) + + instruction_name = req%location(i+1:j-1) + id_from_req = get_instruction_id(trim(instruction_name)) + jobs => get_jobs_for_instruction(id_from_req) + if(associated(jobs)) then + n_jobs = size(jobs) + job_link_text => render_jobs_links(jobs) + else + n_jobs = 0 + job_link_text => null() + end if + + players => get_instruction_players(id_from_req) + if(associated(players)) then + n_players = size(players) + else + n_players = 0 + end if + + nsize = 1024 + if(n_jobs > 0) then + nsize = nsize + len_trim(job_link_text) + end if + if(n_players > 0) then + nsize = nsize + n_players*256 + end if + + nsize = nsize + get_player_count()*(PLAYER_NAME_LENGTH+32) + + allocate(character(len=nsize) :: res) + + res = nl//"## "//trim(instruction_name) + if(n_players == 0) then + res = trim(res)//nl//nl//"No players currently can run these instructions" + else + res = trim(res)//nl//nl//"## Launch Now" + do i = 1, n_players + call get_player_name(players(i), player_name) + if(is_player_busy(players(i))) then + player_status = get_status_utf8(PLAYER_STATUS_BUSY) + else + player_status = get_status_utf8(PLAYER_STATUS_IDLE) + end if + + res = trim(res)//nl//"=> "//trim(req%location)//"?launch="//trim(player_name)// & + " "//trim(player_status)//trim(player_name) + end do + end if + + res = trim(res)//nl//nl//"### Jobs" + if(n_jobs == 0) then + res = trim(res)//nl//"None Yet" + else + res = trim(res)//nl//job_link_text + deallocate(job_link_text) + end if + + all_players => get_player_names() + if(associated(all_players)) then + res = trim(res)//nl//nl//"### Assign"//nl//"Assign a player to these instructions" + do i = 1, size(all_players) + if(n_players > 0) then + j = get_player_id(all_players(i)) + if(any(j == players)) then + cycle + end if + end if + res = trim(res)//nl//"=> "//trim(req%location)//"?assign="//trim(all_players(i))// & + " "//trim(all_players(i)) + end do + deallocate(all_players) + end if + + if(n_players > 0) then + res = trim(res)//nl//nl//"### Remove"//nl//"Remove a player from these instructions" + do i = 1, n_players + call get_player_name(players(i), player_name) + res = trim(res)//nl//"=> "//trim(req%location)//"?remove="//trim(player_name)// & + " "//trim(player_name) + end do + end if + + end function generate_one_instuction_gemini + + subroutine handle_instruction_command(req) + use captain_db + use server_response + use remote_launch + implicit none + + type(request), intent(in)::req + character(32)::command + character(PLAYER_NAME_LENGTH)::argument, instruction_name + + integer::i, j + + i = index(req%location, "/", back=.true.) + j = index(req%location, ".", back=.true.) + + instruction_name = req%location(i+1:j-1) + + i = index(req%query_string, "=") + command = req%query_string(1:i-1) + argument = req%query_string(i+1:len_trim(req%query_string)) + + if(trim(command) == "launch") then + call launch_instructions_on_player(instruction_name, argument) + + else if(trim(command) == "assign") then + i = get_instruction_id(trim(instruction_name)) + j = get_player_id(trim(argument)) + call add_player_for_instruction(i, j) + + else if(trim(command) == "remove") then + i = get_instruction_id(trim(instruction_name)) + j = get_player_id(trim(argument)) + call remove_player_for_instruction(i, j) + + end if + + end subroutine handle_instruction_command + function generate_instructions_gemini() result(res) use captain_db implicit none @@ -163,12 +425,27 @@ contains class(request), intent(in)::req type(response)::resp + character(64)::first + + call req%path_component(1, first) if(req%location == "/players/add.gmi") then call add_player_db(req%query_string) resp%code = GEMINI_CODE_REDIRECT call resp%set_url("/players.gmi") + + else if(req%location == "/jobs.gmi") then + ! Used for paging - send it back + resp = external_request_templated(req) + + else if(trim(first) == "instructions") then + ! Instruction command + call handle_instruction_command(req) + ! Go back to the same location + resp%code = GEMINI_CODE_REDIRECT + call resp%set_url(req%location) + end if end function external_input_request_gemini @@ -180,9 +457,20 @@ contains class(request), intent(in)::req logical::is_request_static - character(64)::first + character(64)::first, last + + character(4)::ext + integer::j call req%path_component(1, first) + call req%last_component(last) + + j = index(last, ".", back=.true.) + if(j > 0) then + ext = last(j+1:len_trim(last)) + else + ext = " " + end if call write_log("Static check: "//trim(first)) @@ -191,7 +479,7 @@ contains (trim(first) == "results") .or. & (trim(first) == "static") .or. & (trim(first) == "favicon.txt") .or. & - (trim(first) == "instructions")) + (trim(first) == "instructions" .and. trim(ext) == "json")) end function is_request_static @@ -301,6 +589,7 @@ contains character(1024)::template_file type(template)::page character(len=:), pointer::contents + character(64)::first ! Open the base template call template_filepath("index.gmi", template_file) @@ -308,6 +597,8 @@ contains call write_log("Processing request") + call req%path_component(1, first) + if(trim(req%location) == "/" .or. trim(req%location) == "/index.gmi") then call write_log("Assign") @@ -321,7 +612,7 @@ contains else if(trim(req%location) == "/jobs.gmi") then call page%assign('title', 'Jobs') - contents => generate_jobs_gemini() + contents => generate_jobs_gemini(req) call page%assign('contents', contents) else if(trim(req%location) == "/players.gmi") then @@ -342,6 +633,12 @@ contains contents => generate_instructions_gemini() call page%assign('contents', contents) + else if(trim(first) == "instructions") then + + call page%assign('title', 'Build Instructions') + contents => generate_one_instuction_gemini(req) + call page%assign('contents', contents) + else call page%assign('title', 'Not Found') -- cgit v1.2.3