which Function

public function which(command) result(pathname)

Name

 which(3f) - [M_io:ENVIRONMENT] given a command name find the pathname by searching
             the directories in the environment variable $PATH
 (LICENSE:PD)

Syntax

function which(command) result(pathname)

character(len=*),intent(in)  :: command
character(len=:),allocatable :: pathname

Description

Given a command name find the first file with that name in the directories
specified by the environment variable $PATH.

options

COMMAND   the command to search for

Returns

PATHNAME  the first pathname found in the current user path. Returns blank
          if the command is not found.

Example

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

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: command

Return Value character(len=:), allocatable


Source Code

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