fileglob(3f) - [M_system:QUERY_FILE] Read output of an ls(1) command from Fortran (LICENSE:PD)
subroutine fileglob(glob,list)
character(len=*),intent(in) :: glob
character(len=*),pointer :: list(:)
Non-portable procedure uses the shell and the ls(1) command to expand
a filename and returns a pointer to a list of expanded filenames.
glob Pattern for the filenames (like: *.txt)
list Allocated list of filenames (returned), the caller must
deallocate it.
Read output of an ls(1) command from Fortran
program demo_fileglob ! simple unit test
call tryit('*.*')
call tryit('/tmp/__notthere.txt')
contains
subroutine tryit(string)
use M_system, only : fileglob
character(len=255),pointer :: list(:)
character(len=*) :: string
call fileglob(string, list)
write(*,*)'Files:',size(list)
write(*,'(a)')(trim(list(i)),i=1,size(list))
deallocate(list)
end subroutine tryit
end program demo_fileglob ! simple unit test
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | glob | |||
| character(len=*), | pointer | :: | list(:) |
subroutine fileglob(glob, list) ! NON-PORTABLE AT THIS POINT. REQUIRES ls(1) command, assumes 1 line per file
! The length of the character strings in list() must be long enough for the filenames.
! The list can be zero names long, it is still allocated.
implicit none
! ident_27="@(#) M_system fileglob(3f) Returns list of files using a file globbing pattern"
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=*),intent(in) :: glob ! Pattern for the filenames (like: *.txt)
character(len=*),pointer :: list(:) ! Allocated list of filenames (returned), the caller must deallocate it.
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=255) :: tmpfile ! scratch filename to hold expanded file list
character(len=255) :: cmd ! string to build system command in
integer :: iotmp ! needed to open unique scratch file for holding file list
integer :: i,ios,icount
write(tmpfile,'(*(g0))')'/tmp/__filelist_',timestamp(),'_',system_getpid() ! preliminary scratch file name
cmd='ls -d '//trim(glob)//'>'//trim(tmpfile)//' ' ! build command string
call execute_command_line(cmd ) ! Execute the command specified by the string.
open(newunit=iotmp,file=tmpfile,iostat=ios) ! open unique scratch filename
if(ios.ne.0) return ! the open failed
icount=0 ! number of filenames in expanded list
do ! count the number of lines (assumed ==files) so know what to allocate
read(iotmp,'(a)', iostat=ios) ! move down a line in the file to count number of lines
if(ios .ne. 0)exit ! hopefully, this is because end of file was encountered so done
icount=icount+1 ! increment line count
enddo
rewind(iotmp) ! rewind file list so can read and store it
allocate(list(icount)) ! allocate and fill the array
do i=1,icount
read(iotmp,'(a)')list(i) ! read a filename from a line
enddo
close(iotmp, status='delete',iostat=ios) ! close and delete scratch file
end subroutine fileglob