Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Portable directory "crawl" from Fortran 1

Status
Not open for further replies.

NickFort

Technical User
Jun 10, 2010
113
0
0
(I could have sworn I posted this a week or so ago, and then it disappeared. I hope it's not a duplicate; if it is, my apologies.)

Is there a portable way of returning the directory structure and contained files to Fortran for processing?

An example of what I want to do:

- Get the directory/file structure
- Parse each file sequentially
- Determine something I need in each file

That way, I could, for example, check that my Makefile has all of the dependencies, or automatically create documentation in TeX format, etc.

One (non-portable) solution is to use system-dependent programs for this. Windows has "tree", so running "tree /F > structure.txt" and then reading and interpreting "structure.txt" in Fortran would do the trick. I'm sure Linux has more powerful ways of doing this.

However, is there a system-independent way of doing it?

--------------------------------------
Background: Chemical engineer, familiar mostly with MATLAB, but now branching out into real programming.
 
It is possible to build an interface module above an almost portable C library. I tested it on Linux and Windows with gcc and intel compilers.

I cannot provide the full module because it uses internally another private libraries. But here is a part to give you an idea how to proceed and a reliable starting point :

Code:
MODULE odessa_file
  USE iso_c_binding
  IMPLICIT NONE
  
  PRIVATE
  
  PUBLIC odfile_info,odfile_remove,odfile_rename,odfile_getcwd,odfile_mkdir,&
         odfile_permission,odfile_chmod,odfile_exist,odfile_splitname,&
         odfile_tmplen,odfile_isdir,odfile_isreg,odfile_isr,odfile_isw,odfile_isx,&
         odfile_listdir,odfile_name,odfile_tmpname,odfile_rmdir,odfile_chdir
         
  SAVE
  
  INTERFACE ! interface to the C libraries
    FUNCTION remove(pathname) BIND(C,name="remove") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in)  :: pathname(*)
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION rename(input,output) BIND(C,name="rename") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in) :: input(*)
      CHARACTER(kind=C_CHAR),INTENT(in) :: output(*)
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION chmod(filename,mode) BIND(C,name="chmod") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in)  :: filename(*)
      INTEGER(C_INT),VALUE  ,INTENT(in)  :: mode
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION chdir(filename) BIND(C,name="chdir") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in)  :: filename(*)
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION mkdir(dirname,mode) BIND(C,name="mkdir") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in)  :: dirname(*)
      INTEGER(C_INT),VALUE  ,INTENT(in)  :: mode
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION rmdir(dirname) BIND(C,name="rmdir") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in)  :: dirname(*)
      INTEGER(C_INT)        :: r
    END FUNCTION
    FUNCTION tmpnam(output) BIND(C,name="tmpnam") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(out) :: output(*)
      TYPE(C_PTR)        :: r
    END FUNCTION
    FUNCTION strlen(string) BIND(C,name="strlen") RESULT(r)
      USE iso_c_binding
      TYPE(C_PTR),VALUE,INTENT(in) :: string
      INTEGER(C_SIZE_T)  :: r
    END FUNCTION
    FUNCTION getcwd(buffer,size) BIND(C,name="getcwd") RESULT(r)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR) ,INTENT(out) :: buffer(*)
      INTEGER(C_SIZE_T),VALUE,INTENT(in)  :: size
      TYPE(C_PTR)  :: r
    END FUNCTION
    FUNCTION opendir(dirname) BIND(C,name="opendir") RESULT(dir)
      USE iso_c_binding
      CHARACTER(kind=C_CHAR),INTENT(in) :: dirname(*)
      TYPE(C_PTR)  :: dir
    END FUNCTION
    FUNCTION readdir(dir) BIND(C,name="readdir") RESULT(dirfile)
      USE iso_c_binding
      TYPE(c_ptr),VALUE,INTENT(in) :: dir
      TYPE(C_PTR)  :: dirfile
    END FUNCTION
    FUNCTION closedir(dir) BIND(C,name="closedir") RESULT(status)
      USE iso_c_binding
      TYPE(c_ptr),VALUE :: dir
      INTEGER(C_INT)  :: status
    END FUNCTION
  END INTERFACE

  CONTAINS

  
  FUNCTION odfile_remove(filename) RESULT(r)
    CHARACTER(*)         ,INTENT(in)  :: filename
    INTEGER(C_INT) :: r
    r= remove(TRIM(filename)//C_NULL_CHAR)
  END FUNCTION
  
  FUNCTION odfile_rmdir(dirname) RESULT(r)
    CHARACTER(*)         ,INTENT(in)  :: dirname
    INTEGER(C_INT) :: r
    r= rmdir(TRIM(dirname)//C_NULL_CHAR)
  END FUNCTION
  
  FUNCTION odfile_chdir(dirname) RESULT(r)
    CHARACTER(*)         ,INTENT(in)  :: dirname
    INTEGER(C_INT) :: r
    r= chdir(TRIM(dirname)//C_NULL_CHAR)
  END FUNCTION
  
  FUNCTION odfile_rename(input,output) RESULT(k)
    CHARACTER(*)         ,INTENT(in)  :: input,output
    INTEGER :: k
    k= rename(TRIM(input)//C_NULL_CHAR,TRIM(output)//C_NULL_CHAR)
  END FUNCTION
  
  SUBROUTINE odfile_getcwd(output)
    CHARACTER(kind=C_CHAR,len=*),INTENT(out) :: output
    TYPE(C_PTR) :: buffer
    INTEGER(C_LONG) :: length,i
    length=LEN(output)
    buffer=getcwd(output,length)
    DO i=1,length
      IF(output(i:i) == C_NULL_CHAR) EXIT
    ENDDO
    output(i:)=' '
  END SUBROUTINE

  ...  

END MODULE

François Jacq
 
Oh, perfect! I've had a look at FLIBS in search of other things before, I've bookmarked it, but now when I need a routine, I completely forgot to check it. Thanks, François!

--------------------------------------
Background: Chemical engineer, familiar mostly with MATLAB, but now branching out into real programming.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top