Initial import

1 files changed, 216 insertions, 0 deletions

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