system_dir Function

public function system_dir(directory, pattern, ignorecase)

Uses

NAME

system_dir(3f) - [M_io] return filenames in a directory matching
specified wildcard string
(LICENSE:PD)

SYNOPSIS

function system_dir(directory,pattern,ignorecase)

character(len=*),intent(in),optional  :: directory
character(len=*),intent(in),optional  :: pattern
logical,intent(in),optional           :: ignorecase
character(len=:),allocatable          :: system_dir(:)

DESCRIPTION

returns an array of filenames in the specified directory matching
the wildcard string (which defaults to "*").

OPTIONS

DIRECTORY   name of directory to match filenames in. Defaults to ".".
PATTERN     wildcard string matching the rules of the matchw(3f)
            function. Basically
             o "*" matches anything
             o "?" matches any single character
IGNORECASE  Boolean value indicating whether to ignore case or not
            when performing matching

RETURNS

system_dir  An array right-padded to the length of the longest
            filename. Note that this means filenames actually
            containing trailing spaces in their names may be
            incorrect.

EXAMPLE

Sample program:

program demo_system_dir
use M_system, only : system_dir, system_isdir
character(len=:),allocatable :: dirname
implicit none
   write(*, '(a)')system_dir(pattern='*.f90')
   dirname='/tmp'
   if(system_isdir(dirname))then
      write(*, '(a)')system_dir(pattern='*.f90')
   else
      write(*, '(a)')'<WARNING:>'//dirname//' does not exist'
   endif
end program demo_system_dir

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: directory
character(len=*), intent(in), optional :: pattern
logical, intent(in), optional :: ignorecase

Return Value character(len=:), allocatable, (:)


Contents

Source Code

system_dir

Source Code

function system_dir(directory,pattern,ignorecase)
!use M_system, only : system_opendir, system_readdir, system_rewinddir, system_closedir, system_isdir
use iso_c_binding
implicit none
character(len=*),intent(in),optional  :: directory
character(len=*),intent(in),optional  :: pattern
logical,intent(in),optional           :: ignorecase
character(len=:),allocatable          :: system_dir(:)
character(len=:),allocatable          :: wild
type(c_ptr)                           :: dir
character(len=:),allocatable          :: filename
integer                               :: i, ierr, icount, longest
   longest=0
   icount=0
   if(present(pattern))then
      wild=pattern
   else
      wild='*'
   endif
   if(present(directory))then                        !--- open directory stream to read from
      if(system_isdir(trim(directory)))then
         call system_opendir(trim(directory), dir, ierr)
      else
         ierr=-1
      endif
   else
      call system_opendir('.', dir, ierr)
   endif
   if(ierr.eq.0)then
      do i=1, 2                                      !--- read directory stream twice, first time to get size
         do
            call system_readdir(dir, filename, ierr)
            if(filename.eq.' ')exit
            if(wild.ne.'*')then
              if(.not.matchw(filename, wild, ignorecase))cycle   ! Call a wildcard matching routine.
            endif
            icount=icount+1
            select case(i)
            case(1)
               longest=max(longest, len(filename))
            case(2)
               system_dir(icount)=filename
            end select
         enddo
         if(i.eq.1)then
            call system_rewinddir(dir)
            if(allocated(system_dir))deallocate(system_dir)
            allocate(character(len=longest) :: system_dir(icount))
            icount=0
         endif
      enddo
      call system_closedir(dir, ierr)                   !--- close directory stream
   endif
   if(.not.allocated(system_dir)) allocate(character(len=0) :: system_dir(0))
end function system_dir