process_readall Function

public function process_readall(cmd, delim, ierr) result(string)

NAME

process_readall(3f) - [M_process] read all lines from process into
single string
(LICENSE:PD)

SYNOPSIS

syntax:

function process_readall(cmd,delim,ierr)  result(string)

   character(len=*),intent(in)              :: cmd
   character(len=*),intent(in),optional     :: delim
   integer,intent(out),optional             :: ierr
   character(len=:),allocatable             :: string

OPTIONS

   cmd        command to pass to system
   delim      delimiter to place between output lines when they
              are concatenated. Defaults to a space
   ierr       check status of call.

RESULTS

   process_readall   Assuming sufficient memory is available all the
                     output of the system command are concatenated
                     into a string with spaces added between the
                     output lines of the command.

EXAMPLE

Read all output of a command to a single string

 program demo_process_readall
  use M_process, only: process_readall
  implicit none
  integer :: ierr
  character(len=:),allocatable :: string
      string=process_readall('ls',ierr=ierr)
      write(*,*)ierr,string
  end program demo_process_readall

Results:

app build docs example fpm.toml LICENSE man README.md src test

Read all output of a command to an array using split(3f)

  program test_process_readall
   use M_process ,only: process_readall
   use M_strings ,only: split
   implicit none
   integer                      :: ierr
   integer                      :: i
   character(len=:),allocatable :: string
   character(len=:),allocatable :: array(:)
      string=process_readall('ls',delim=NEW_LINE("A"),ierr=ierr)
      call split(string,array,delimiters=NEW_LINE("A"))
      do i=1,size(array)
         write(*,'(i0,t10,"[",a,"]")')i,trim(array(i))
      enddo
      write(*,*)string=process_readall(&
      & 'ls',delim=NEW_LINE("A"),ierr=ierr)
      write(*,*)string
   end program test_process_readall

Results:

   > 1     [Articles]
   > 2     [LIBRARY]
   > 3     [PC]
   > 4     [SHIP]
   > 5     [SPEC]
   > 6     [crib.dat]
   > 7     [doc]
   > 8     [html]
   > 9     [index.html]
   > 10    [plan.txt]
   > 11    [questions]
   > 12    [scripts]
   > 13    [tmp]

SEE ALSO

M_process(3fm)

AUTHOR

John S. Urban

LICENSE

Public Domain

not hardened

change to stream I/O so do not have to have arbitrary line length limit, or at least make length an option write(,)’M_process::process_readall(3f) error values=’,ierr_local

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: cmd
character(len=*), intent(in), optional :: delim
integer, intent(out), optional :: ierr

Return Value character(len=:), allocatable

assume will not run out of memory


Contents

Source Code


Source Code

function process_readall(cmd,delim,ierr)  result(string)      !! not hardened

! ident_7="@(#)M_process::process_readall(3f): read all lines from process"

character(len=*),intent(in)    :: cmd
character(len=:),allocatable   :: string  !! assume will not run out of memory
character(len=*),intent(in),optional  :: delim
integer,intent(out),optional   :: ierr

character(len=:),allocatable   :: delim_local
integer                        :: ierr_local(3), ierr_read
integer                        :: i
type(streampointer)            :: fp
character(len=4096)            :: line    !! assumed long enough
!-------------------------------------------------------------------------------
   if(present(delim))then
      delim_local=delim
   else
      delim_local=' '
   endif

   !! change to stream I/O so do not have to have arbitrary line length limit,
   !! or at least make length an option
   string=''
   ierr_local(:)=0
   call process_open_read(cmd,fp,ierr_local(1))  ! start command

   if(ierr_local(1).eq.0)then
      do
         ! read line from command output
         call process_readline(line,fp,ierr_read)
         if(ierr_read.ne.0)then
            exit
         endif
         string=string//trim(line)//delim_local
      enddo
      string=trim(string)
   endif

   call process_close(fp,ierr_local(3)) ! Wrap up

   if(present(ierr))then
      do i=1,size(ierr_local)
         if(ierr_local(i).ne.0)then
            ierr=ierr_local(i)
            exit
         endif
      enddo
   elseif(any(ierr_local.ne.0))then
      !!write(*,*)'*M_process::process_readall(3f)* error values=',ierr_local
      stop "*M_process::process_readall(3f)* error"
   endif

end function process_readall