From fb11ffeb2d98f239b20e618c65b8534b677957e9 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Wed, 24 Mar 2021 14:58:32 -0400 Subject: Initial import --- player/tasks.f90 | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 216 insertions(+) create mode 100644 player/tasks.f90 (limited to 'player/tasks.f90') diff --git a/player/tasks.f90 b/player/tasks.f90 new file mode 100644 index 0000000..c64cb40 --- /dev/null +++ b/player/tasks.f90 @@ -0,0 +1,216 @@ +module tasks +implicit none + +contains + + function shell(command, directory, capture_filename) + use config + use utilities + implicit none + + logical::shell + character(*), intent(in)::command + character(*), intent(in)::directory + character(*), intent(in)::capture_filename + + character(len=:), allocatable::task_directory + + integer::return_value, details_unit + integer, dimension(8)::timedate_start, timedate_end + + shell = .false. + + if(is_absolute_path(directory)) then + call chdir(directory) + else + allocate(character(len=(len_trim(directory) + len_trim(working_directory) + 1)) :: task_directory) + call combine_paths(working_directory, directory, task_directory) + call chdir(task_directory) + end if + + call date_and_time(values=timedate_start) + + call execute_command_line(trim(command)//" 1>> "//trim(capture_filename)//" 2>&1", & + wait=.true., exitstat=return_value) + + shell = (return_value == 0) + + ! Write out some final info + open(newunit=details_unit, file=capture_filename, status="old", access="append") + write(details_unit, *) repeat("=", 80) + write(details_unit, '(1X, A25, I3)') "Task Completed with Code ", return_value + + call date_and_time(values=timedate_end) + + write(details_unit, '(1X, A8, 1X)', advance='no') "Started:" + call write_date_and_time(details_unit, timedate_start) + + write(details_unit, '(1X, A8, 1X)', advance='no') " Ended:" + call write_date_and_time(details_unit, timedate_end) + + write(details_unit, *) "Command:" + write(details_unit, *) " "//trim(command) + + write(details_unit, *) "Working Directory:" + if(allocated(task_directory)) then + write(details_unit, *) " "//trim(task_directory) + else + write(details_unit, *) " "//trim(directory) + end if + + write(details_unit, *) repeat("=", 80) + close(details_unit) + + call chdir(working_directory) + + if(allocated(task_directory)) then + deallocate(task_directory) + end if + + end function shell + + function upload(url, source_filename) + use config, only: token + use gemini_protocol, only: titan_post_url, STATUS_SUCCESS + implicit none + + logical::upload + character(*), intent(in)::url + character(*), intent(in)::source_filename + + character(len=:), allocatable::mod_url + + integer(kind=8)::file_size + integer::unit_number, istatus + + inquire(file=source_filename, size=file_size) + + open(newunit=unit_number, file=trim(source_filename), status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + if(istatus == 0) then + istatus = titan_post_url(mod_url, unit_number, file_size, token) + upload = (istatus == STATUS_SUCCESS) + close(unit_number) + else + upload = .false. + end if + + deallocate(mod_url) + + end function upload + + function download(url, destination_filename) + use gemini_protocol, only: request_url, STATUS_SUCCESS + implicit none + + logical::download + character(*), intent(in)::url + character(*), intent(in)::destination_filename + + character(len=256)::mimetype + + character(len=:), allocatable::mod_url + + integer::unit_number, istatus + + allocate(character(len=len_trim(url)) :: mod_url) + mod_url = url + + open(newunit=unit_number, file=trim(destination_filename), status='UNKNOWN', & + access='STREAM', form='UNFORMATTED', iostat=istatus) + + if(istatus == 0) then + istatus = request_url(mod_url, unit_number, mimetype) + download = (istatus == STATUS_SUCCESS) + close(unit_number) + else + download = .false. + end if + + deallocate(mod_url) + + end function download + + function git_update(origin, branch, directory, destructive, capture_filename) + use config + implicit none + + logical::git_update + character(*), intent(in)::origin + character(*), intent(in)::directory + character(*), intent(in)::branch + logical, intent(in)::destructive + character(*), intent(in)::capture_filename + + logical::res + integer::retval + character(len=32)::options + + ! If we're working in destructive mode, just checkout the current head + if(destructive) then + res = delete_tree(directory) + options = " --depth 1" + else + options = " " + end if + + call execute_command_line("mkdir "//trim(directory), wait=.true., exitstat=retval) + + ! If Zero, there is no existing directory... + if(retval == 0) then + res = shell("git clone"//trim(options)//" "//trim(origin)//" "//trim(directory), working_directory, capture_filename) + if(res) then + res = shell("git submodule init", directory, capture_filename) + end if + else + res = .true. + end if + + ! Check that nothing went wrong so far... + if(res) then + res = shell("git checkout "//trim(branch), directory, capture_filename) + if(res) then + res = shell("git submodule update", directory, capture_filename) + end if + end if + + git_update = res + + end function git_update + + function delete_tree(directory) + use config, only: working_directory + use utilities + implicit none + + logical::delete_tree + character(*), intent(in)::directory + character(len=:), allocatable::fulldir + + ! Only proceed in the working directory... + ! Relative paths could still break this, but what can you do... + if(is_absolute_path(directory)) then + delete_tree = .false. + else + + allocate(character(len=( len_trim(working_directory)+len_trim(directory)+1 )) :: fulldir) + call combine_paths(working_directory, directory, fulldir) + + ! No spaces allowed. Tough... + if(index(fulldir, " ") /= 0) then + delete_tree = .false. + else + delete_tree = remove_directory(fulldir) + end if + + deallocate(fulldir) + + end if + + end function delete_tree + +end module tasks -- cgit v1.2.3