which(3f) - [M_io:ENVIRONMENT] given a command name find the pathname by searching
the directories in the environment variable $PATH
(LICENSE:PD)
function which(command) result(pathname)
character(len=*),intent(in) :: command
character(len=:),allocatable :: pathname
Given a command name find the first file with that name in the directories
specified by the environment variable $PATH.
COMMAND the command to search for
PATHNAME the first pathname found in the current user path. Returns blank
if the command is not found.
Sample program:
Checking the error message and counting lines:
program demo_which
use M_io, only : which
implicit none
write(*,*)'ls is ',which('ls')
write(*,*)'dir is ',which('dir')
write(*,*)'install is ',which('install')
end program demo_which
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | command |
function which(command) result(pathname)
character(len=*),intent(in) :: command
character(len=:),allocatable :: pathname, checkon, paths(:), exts(:)
integer :: i, j
pathname=''
call split(get_env('PATH'),paths,delimiters=merge(';',':',separator()=='\'))
SEARCH: do i=1,size(paths)
checkon=trim(join_path(trim(paths(i)),command))
select case(separator())
case('/')
if(exists(checkon))then
pathname=checkon
exit SEARCH
endif
case('\')
if(exists(checkon))then
pathname=checkon
exit SEARCH
endif
if(exists(checkon//'.bat'))then
pathname=checkon//'.bat'
exit SEARCH
endif
if(exists(checkon//'.exe'))then
pathname=checkon//'.exe'
exit SEARCH
endif
call split(get_env('PATHEXT'),exts,delimiters=';')
do j=1,size(exts)
if(exists(checkon//'.'//trim(exts(j))))then
pathname=checkon//'.'//trim(exts(j))
exit SEARCH
endif
enddo
end select
enddo SEARCH
end function which