SYSTEM_STAT - [M_system:QUERY_FILE] Get file status information
(LICENSE:PD)
CALL SYSTEM_STAT(NAME, VALUES [, STATUS],[DEBUG])
character(len=*),intent(in) :: NAME
integer(kind=int64),intent(out) :: values(13)
integer,optional,intent(out) :: status
integer,intent(in) :: debug
This function returns information about a file. No permissions are
required on the file itself, but execute (search) permission is required
on all of the directories in path that lead to the file. The elements
that are obtained and stored in the array VALUES:
VALUES(1) Device ID
VALUES(2) Inode number
VALUES(3) File mode
VALUES(4) Number of links
VALUES(5) Owner's uid
VALUES(6) Owner's gid
VALUES(7) ID of device containing directory entry for file (0 if
not available)
VALUES(8) File size (bytes)
VALUES(9) Last access time as a Unix Epoch time rounded to seconds
VALUES(10) Last modification time as a Unix Epoch time rounded
to seconds
VALUES(11) Last file status change time as a Unix Epoch time
rounded to seconds
VALUES(12) Preferred I/O block size (-1 if not available)
VALUES(13) Number of blocks allocated (-1 if not available)
Not all these elements are relevant on all systems. If an element is
not relevant, it is returned as 0.
NAME The type shall be CHARACTER, of the default kind and a valid
path within the file system.
VALUES The type shall be INTEGER(8), DIMENSION(13).
STATUS (Optional) status flag of type INTEGER(4). Returns 0 on success
and a system specific error code otherwise.
DEBUG (Optional) print values being returned from C routine being
called if value of 0 is used
program demo_system_stat
use M_system, only : system_stat, system_getpwuid, system_getgrgid
use M_time, only : fmtdate, u2d
use, intrinsic :: iso_fortran_env, only : int32, int64
implicit none
integer(kind=int64) :: buff(13)
integer(kind=int32) :: status
character(len=*),parameter :: fmt_date='year-month-day hour:minute:second'
integer(kind=int64) :: &
Device_ID, Inode_number, File_mode, Number_of_links, Owner_uid, &
Owner_gid, Directory_device, File_size, Last_access, Last_modification,&
Last_status_change, Preferred_block_size, Number_of_blocks_allocated
equivalence &
( buff(1) , Device_ID ) , &
( buff(2) , Inode_number ) , &
( buff(3) , File_mode ) , &
( buff(4) , Number_of_links ) , &
( buff(5) , Owner_uid ) , &
( buff(6) , Owner_gid ) , &
( buff(7) , Directory_device ) , &
( buff(8) , File_size ) , &
( buff(9) , Last_access ) , &
( buff(10) , Last_modification ) , &
( buff(11) , Last_status_change ) , &
( buff(12) , Preferred_block_size ) , &
( buff(13) , Number_of_blocks_allocated )
CALL SYSTEM_STAT("/etc/hosts", buff, status)
if (status == 0) then
write (*, FMT="('Device ID(hex/decimal):', &
& T30, Z0,'h/',I0,'d')") buff(1),buff(1)
write (*, FMT="('Inode number:', &
& T30, I0)") buff(2)
write (*, FMT="('File mode (octal):', &
& T30, O19)") buff(3)
write (*, FMT="('Number of links:', &
& T30, I0)") buff(4)
write (*, FMT="('Owner''s uid/username:', &
& T30, I0,1x, A)") buff(5), system_getpwuid(buff(5))
write (*, FMT="('Owner''s gid/group:', &
& T30, I0,1x, A)") buff(6), system_getgrgid(buff(6))
write (*, FMT="('Device where located:', &
& T30, I0)") buff(7)
write (*, FMT="('File size(bytes):', &
& T30, I0)") buff(8)
write (*, FMT="('Last access time:', &
& T30, I0,1x, A)") buff(9), fmtdate(u2d(int(buff(9))),fmt_date)
write (*, FMT="('Last modification time:', &
& T30, I0,1x, A)") buff(10),fmtdate(u2d(int(buff(10))),fmt_date)
write (*, FMT="('Last status change time:', &
& T30, I0,1x, A)") buff(11),fmtdate(u2d(int(buff(11))),fmt_date)
write (*, FMT="('Preferred block size(bytes):', &
& T30, I0)") buff(12)
write (*, FMT="('No. of blocks allocated:', &
& T30, I0)") buff(13)
endif
end program demo_system_stat
Results:
Device ID(hex/decimal): 3E6BE045h/1047257157d
Inode number: 1407374886070599
File mode (octal): 100750
Number of links: 1
Owner's uid/username: 18 SYSTEM
Owner's gid/group: 18 SYSTEM
Device where located: 0
File size(bytes): 824
Last access time: 1557983191 2019-05-16 01:06:31
Last modification time: 1557983191 2019-05-16 01:06:31
Last status change time: 1557983532 2019-05-16 01:12:12
Preferred block size(bytes): 65536
No. of blocks allocated: 4
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | pathname | |||
| integer(kind=int64), | intent(out) | :: | values(13) | |||
| integer, | intent(out), | optional | :: | ierr |
subroutine system_stat(pathname,values,ierr)
implicit none
! ident_32="@(#) M_system system_stat(3f) call stat(3c) to get pathname information"
character(len=*),intent(in) :: pathname
integer(kind=int64),intent(out) :: values(13)
integer(kind=c_long) :: cvalues(13)
integer,optional,intent(out) :: ierr
integer(kind=c_int) :: cierr
character(kind=c_char,len=1),allocatable :: temp(:)
interface
subroutine c_stat(buffer,cvalues,cierr,cdebug) bind(c,name="my_stat")
import c_char, c_size_t, c_ptr, c_int, c_long
character(kind=c_char),intent(in) :: buffer(*)
integer(kind=c_long),intent(out) :: cvalues(*)
integer(kind=c_int) :: cierr
integer(kind=c_int),intent(in) :: cdebug
end subroutine c_stat
end interface
!-----------------------------------------------------------------------------------------------------------------------------------
temp = str2_carr(trim(pathname)) ! kludge for bug in ifort (IFORT) 2021.3.0 20210609
call c_stat(temp,cvalues,cierr,0_c_int)
values=cvalues
if(present(ierr))then
ierr=cierr
endif
end subroutine system_stat