diff options
Diffstat (limited to 'src/fpm_filesystem.f90')
| -rw-r--r-- | src/fpm_filesystem.f90 | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index c9c97dd..e6226b4 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -5,15 +5,18 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + use fpm_environment, only: separator, get_env use fpm_strings, only: f_string, replace, string_t, split implicit none private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name public :: fileopen, fileclose, filewrite, warnwrite, parent_dir + public :: which integer, parameter :: LINE_BUFFER_LEN = 1000 + contains @@ -181,6 +184,7 @@ function dirname(path) result (dir) character(:), allocatable :: dir dir = path(1:scan(path,'/\',back=.true.)) + if (len_trim(dir) == 0) dir = "." end function dirname @@ -618,4 +622,84 @@ pure function to_fortran_name(string) result(res) res = replace(string, SPECIAL_CHARACTERS, '_') end function to_fortran_name +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 +!! +!!##AUTHOR +!! John S. Urban +!!##LICENSE +!! Public Domain + +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().eq.'\')) + 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 + end module fpm_filesystem |