implement callback

Author: perazz

src/stdlib_system.F90

@@ -37,8 +37,9 @@ module stdlib_system
     logical :: completed = .false.        
     integer(TICKS) :: start_time = 0
 
-    !> Stdin file name
+    !> Standard input
     character(:), allocatable :: stdin_file
+    character(:), allocatable :: stdin
 
     !> Standard output
     character(:), allocatable :: stdout_file
@@ -49,6 +50,12 @@ module stdlib_system
     character(:), allocatable :: stderr_file
     character(:), allocatable :: stderr
 
+    !> Callback function 
+    procedure(process_callback), nopass, pointer :: oncomplete => null()
+    
+    !> Optional payload for the callback function
+    class(*), pointer :: payload => null()
+    
     !> Store time at the last update
     integer(TICKS) :: last_update = 0
 
@@ -90,9 +97,9 @@ module stdlib_system
     !! Processes can be executed via a single command string or a list of arguments, with options to collect 
     !! standard output and error streams, or to provide a standard input stream via a `character` string.
     !!
-    !! @note The implementation depends on system-level process management capabilities.
+    !! @note The implementation depends on system-level process management capabilitiesa
     !!
-    module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process)
+    module function run_async_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> The command line string to execute.
         character(*), intent(in) :: cmd
         !> Optional input sent to the process via standard input (stdin).
@@ -101,11 +108,16 @@ module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(proce
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload
         !> The output process handler.
         type(process_type) :: process
+        
     end function run_async_cmd
 
-    module function run_async_args(args, stdin, want_stdout, want_stderr) result(process)
+    module function run_async_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> List of arguments for the process to execute.
         character(*), intent(in) :: args(:)
         !> Optional input sent to the process via standard input (stdin).
@@ -114,6 +126,10 @@ module function run_async_args(args, stdin, want_stdout, want_stderr) result(pro
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler.
         type(process_type) :: process        
     end function run_async_args
@@ -137,7 +153,7 @@ end function run_async_args
     !!
     !! @note The implementation depends on system-level process management capabilities.
     !!
-    module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process)
+    module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> The command line string to execute.
         character(*), intent(in) :: cmd
         !> Optional input sent to the process via standard input (stdin).
@@ -146,11 +162,15 @@ module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(proces
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload            
         !> The output process handler.
         type(process_type) :: process
     end function run_sync_cmd
 
-    module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process)
+    module function run_sync_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> List of arguments for the process to execute.
         character(*), intent(in) :: args(:)
         !> Optional input sent to the process via standard input (stdin).
@@ -159,6 +179,10 @@ module function run_sync_args(args, stdin, want_stdout, want_stderr) result(proc
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload            
         !> The output process handler.
         type(process_type) :: process        
     end function run_sync_args
@@ -342,6 +366,21 @@ module subroutine sleep(millisec)
     end subroutine sleep
 end interface sleep
 
+abstract interface
+    subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload)
+        import process_ID
+        implicit none
+        !> Process ID
+        integer(process_ID), intent(in) :: pid
+        !> Process return state
+        integer, intent(in) :: exit_state
+        !> Process input/output: presence of these arguments depends on how process was created
+        character(len=*), optional, intent(in) :: stdin,stdout,stderr
+        !> Optional payload passed by the user on process creation
+        class(*), optional, intent(inout) :: payload        
+    end subroutine process_callback
+end interface          
+      
 interface 
 
     !! version: experimental

src/stdlib_system_subprocess.F90

@@ -1,7 +1,6 @@
 submodule (stdlib_system) stdlib_system_subprocess
     use iso_c_binding  
     use iso_fortran_env, only: int64, real64
-    use stdlib_system
     use stdlib_strings, only: to_c_string, join
     use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling
     implicit none(type, external)
@@ -85,7 +84,7 @@ module subroutine sleep(millisec)
 
     end subroutine sleep
 
-    module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process)
+    module function run_async_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> The command line string to execute.
         character(*), intent(in) :: cmd
         !> Optional input sent to the process via standard input (stdin).
@@ -94,14 +93,18 @@ module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(proce
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler.
         type(process_type) :: process
 
-        process = process_open([cmd],.false.,stdin,want_stdout,want_stderr)
+        process = process_open([cmd],.false.,stdin,want_stdout,want_stderr,callback,payload)
 
     end function run_async_cmd
 
-    module function run_async_args(args, stdin, want_stdout, want_stderr) result(process)
+    module function run_async_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> List of arguments for the process to execute.
         character(*), intent(in) :: args(:)
         !> Optional input sent to the process via standard input (stdin).
@@ -110,14 +113,18 @@ module function run_async_args(args, stdin, want_stdout, want_stderr) result(pro
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler.
         type(process_type) :: process  
 
-        process = process_open(args,.false.,stdin,want_stdout,want_stderr)
+        process = process_open(args,.false.,stdin,want_stdout,want_stderr,callback,payload)
 
     end function run_async_args
 
-    module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process)
+    module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> The command line string to execute.
         character(*), intent(in) :: cmd
         !> Optional input sent to the process via standard input (stdin).
@@ -126,14 +133,18 @@ module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(proces
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload                
         !> The output process handler.
         type(process_type) :: process
 
-        process = process_open([cmd],.true.,stdin,want_stdout,want_stderr)
+        process = process_open([cmd],.true.,stdin,want_stdout,want_stderr,callback,payload)
 
     end function run_sync_cmd
 
-    module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process)
+    module function run_sync_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process)
         !> List of arguments for the process to execute.
         character(*), intent(in) :: args(:)
         !> Optional input sent to the process via standard input (stdin).
@@ -142,15 +153,19 @@ module function run_sync_args(args, stdin, want_stdout, want_stderr) result(proc
         logical, optional, intent(in) :: want_stdout
         !> Whether to collect standard error output.
         logical, optional, intent(in) :: want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler.
         type(process_type) :: process  
 
-        process = process_open(args,.true.,stdin,want_stdout,want_stderr)
+        process = process_open(args,.true.,stdin,want_stdout,want_stderr,callback,payload)
 
     end function run_sync_args
 
     !> Internal function: open a new process from a command line
-    function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process)
+    function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr,callback,payload) result(process)
         !> The command and arguments
         character(*), intent(in) :: cmd
         !> Optional character input to be sent to the process via pipe
@@ -159,15 +174,19 @@ function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process
         logical, intent(in) :: wait
         !> Require collecting output
         logical, optional, intent(in) :: want_stdout, want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler
         type(process_type) :: process        
 
-        process = process_open([cmd],wait,stdin,want_stdout,want_stderr)
+        process = process_open([cmd],wait,stdin,want_stdout,want_stderr,callback,payload)
 
     end function process_open_cmd
 
     !> Internal function: open a new process from arguments
-    function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
+    function process_open(args,wait,stdin,want_stdout,want_stderr,callback,payload) result(process)
         !> The command and arguments
         character(*), intent(in) :: args(:)
         !> Optional character input to be sent to the process via pipe
@@ -176,6 +195,10 @@ function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
         logical, intent(in) :: wait
         !> Require collecting output
         logical, optional, intent(in) :: want_stdout, want_stderr
+        !> Optional callback function to be called on process completion
+        procedure(process_callback), optional :: callback
+        !> Optional payload to pass to the callback on completion
+        class(*), optional, intent(inout), target :: payload        
         !> The output process handler
         type(process_type) :: process
 
@@ -197,6 +220,19 @@ function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
         if (collect_stdout) process%stdout_file = scratch_name('out')            
         if (collect_stderr) process%stderr_file = scratch_name('err')
 
+        ! Attach callback function and payload
+        if (present(callback)) then 
+            process%oncomplete => callback
+        else
+            nullify(process%oncomplete)
+        end if
+        
+        if (present(payload)) then 
+            process%payload => payload
+        else
+            nullify(process%payload)            
+        end if
+        
         ! Save the process's generation time
         call system_clock(process%start_time,count_rate,count_max)
         process%last_update = process%start_time                
@@ -452,23 +488,33 @@ subroutine save_completed_state(process,delete_files)
         ! Clean up process state using waitpid
         if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, running, exit_code)
 
-        ! Process is over: load stdout/stderr if requested
+        ! Process is over: load stderr if requested
         if (allocated(process%stderr_file)) then 
            process%stderr = getfile(process%stderr_file,delete=delete_files)
            deallocate(process%stderr_file)
         endif
 
+        ! Process is over: load stdout if requested
         if (allocated(process%stdout_file)) then 
            process%stdout = getfile(process%stdout_file,delete=delete_files)
            deallocate(process%stdout_file)
         endif         
 
+        ! Process is over: delete stdin file if it was provided
         if (allocated(process%stdin_file)) then 
-            open(newunit=delete,file=process%stdin_file,access='stream',action='write')
-            close(delete,status='delete')
+            process%stdin = getfile(process%stdin_file,delete=delete_files)
             deallocate(process%stdin_file)
         end if
 
+        ! Process is over: invoke callback if requested
+        if (associated(process%oncomplete)) &
+            call process%oncomplete(process%id,        &
+                                    process%exit_code, &
+                                    process%stderr,    &
+                                    process%stdout,    &
+                                    process%stderr,    &
+                                    process%payload)
+        
     end subroutine save_completed_state
 
     !> Live check if a process is running