|
midrange.com
I am receiving an IFS file that appears to have type STMF. I want to
automatically FTP that file from one AS/400 to another using RPG IV. I
need to make sure that the file is completely written. I have heard you
could use fcntl() to see if there is a lock on the file in order to
determine if data is still being written. I have never really programmed
with IFS files before but I have learned quite a bit from this RPG list and
the information center. I have the source code below written for test
purposes only just to see if there is a lock on the file. I tried testing
with two different types of opens and partly because I saw something about
using 2 opens to open a file. I don't think I have anything in the /Copy
that I am using in the code so all definitions should be seen below. I
intend to test by doing a "2" from the WRKLNK to hopefully place a lock on
the file. I tested using stat() but I couldn't find a lock, so I added the
open() and fcntl() to check for a lock. Please help me find what I am
missing or have coded wrong. Also, please do not direct me to a website
that does not have an example and does not apply to my case. I have
already searched and I get more and more confused.
Thanks,
Craig Strong
====================================================
H Copyright('(C) Copyright Group Dekko Services, LLC')
H Bnddir('ROUTINES/SRVPGM':'QC2LE')
H ActGrp(*CALLER) DftActGrp(*NO) ExprOpts(*RESDECPOS) DatFmt(*USA)
* ================ Definition Specifications ===================
/Copy ROUTINES/QRPGLESRC,SRVPGMCPY
* Program Variables Begin --------------------------------------
D ReturnInt S 10I 0
D statSize S 10I 0
D FileName S 512A Varying
D FileDesc S 10I 0
D AsciiCodePage S 10U 0 INZ(819)
D CodePage S 10U 0 INZ(37)
D p_errno S *
D errno S Based(p_errno) Like(ErrorCode)
D ErrorCode S 10I 0
* Program Variables End ----------------------------------------
*****************************************************************
* IFS CONSTANTS
*****************************************************************
*** Constants for stdio
D SEEK_SET S 10I 0 INZ(0)
Start offset of file
D SEEK_CUR S 10I 0 INZ(1)
Current file offset
D SEEK_END S 10I 0 INZ(2)
End of the file
*** cmd Values for fcntl()
D F_DUPFD S 10I 0 INZ(0)
Duplicate a file des
D F_GETLK S 10I 0 INZ(3)
Get locking informat
D F_SETLK S 10I 0 INZ(4)
Set locking informat
D F_SETLKW S 10I 0 INZ(5)
Set locking informat
D F_GETFL S 10I 0 INZ(6)
Get file status flag
D F_SETFL S 10I 0 INZ(7)
Set file status flag
*** Constants for l_type in flock for cntl()
D F_RDLCK S 10I 0 INZ(1)
Read lock
D F_WRLCK S 10I 0 INZ(2)
Write lock
D F_UNLCK S 10I 0 INZ(3)
Remove lock
*** File Access Modes for open()
D O_RDONLY S 10I 0 INZ(1)
Open for reading onl
D O_WRONLY S 10I 0 INZ(2)
Open for writing onl
D O_RDWR S 10I 0 INZ(4)
Open for reading and
*** oflag Values for open()
D O_CREAT S 10I 0 INZ(8)
Create file if it do
D O_EXCL S 10I 0 INZ(16)
Exclusive use flag
D O_TRUNC S 10I 0 INZ(64)
Truncate flag
*** File Status Flags for open() and fcntl()
D O_NONBLOCK S 10I 0 INZ(128)
No delay...return EA
D O_APPEND S 10I 0 INZ(256)
Set append mode
*** oflag Share Mode Values for open()
D O_SHARE_NONE S 10I 0 INZ(2000000)
Share with neither r
D O_SHARE_RDONLY S 10I 0 INZ(0200000)
Share with readers o
D O_SHARE_RDWR S 10I 0 INZ(1000000)
Share with readers a
D O_SHARE_WRONLY S 10I 0 INZ(0400000)
Share with writers o
*** file permissions
D S_IRUSR S 10I 0 INZ(256)
Owner - read
D S_IWUSR S 10I 0 INZ(128)
Owner - write
D S_IXUSR S 10I 0 INZ(64)
Owner - execute
D S_IRWXU S 10I 0 INZ(448)
Owner - all
D S_IRGRP S 10I 0 INZ(32)
Group - read
D S_IWGRP S 10I 0 INZ(16)
Group - write
D S_IXGRP S 10I 0 INZ(8)
Group - excecute
D S_IRWXG S 10I 0 INZ(56)
Group - all
D S_IROTH S 10I 0 INZ(4)
Others - read
D S_IWOTH S 10I 0 INZ(2)
Others - write
D S_IXOTH S 10I 0 INZ(1)
Others - execute
D S_IRWXO S 10I 0 INZ(7)
Others - all
*** misc
D O_TEXTDATA S 10I 0 INZ(16777216)
Owner - read
D O_CODEPAGE S 10I 0 INZ(8388608)
Owner - read
D flock DS
D l_type 5I 0
F_RDLCK...
D l_whence 5I 0
Flag for offset
*****************************************************************
* IFS PROTOTYPES
*****************************************************************
* Error number
D errnof PR * ExtProc('__errno')
* Retrieve information about an IFS file
D stat PR 10I 0 ExtProc('stat')
D path * Value Options(*String)
D buf * Value
* Open an IFS file
D open PR 10I 0 ExtProc('open')
D filename * Value Options(*String)
D openflags 10I 0 Value
D mode 10U 0 Value Options(*NoPass)
D codepage 10U 0 Value Options(*NoPass)
* Close an IFS file
D close PR 10I 0 ExtProc('close')
D filehandle 10I 0 Value
* Perform file control
D fcntl PR 10I 0 ExtProc('fcntl')
D fildes 10I 0 Value
D cmd 10I 0 Value
D arg Value Like(flock)
* Delete an IFS file
D unlink PR 10I 0 ExtProc('unlink')
D path * Value Options(*String)
* stat data sructure
D p_statDS S *
D statDS DS 128 Based(p_statDS)
D st_mode 10U 0
D st_ino 10U 0
D st_nlink 5U 0
D st_reserved1 2A
D st_uid 10U 0
D st_gid 10U 0
D st_size 10U 0
D st_atime 10U 0
D st_mtime 10U 0
D st_ctime 10U 0
D st_dev 10U 0
D st_blksize 10I 0
D st_allocsize 10I 0
D st_objtype 10A
D st_reserved2 2A
D st_codepage 5U 0
D st_reserved3 62A
D st_ino_gen_id 10U 0
* ================ Begin Calculation Specifications ============
C Eval FileName = '/hmup/craigsdem.demand'
C Eval p_errno = errnof
C Eval errno = 0
* Retrieve file status
C Eval statSize = %Size(statDS)
C Alloc statSize p_statDS
C If stat(FileName:p_statDS) < 0
* Invalid status
C EndIf
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
C Dealloc p_statDS
* Open file
C Eval FileDesc = open(FileName
C : O_WRONLY + O_CODEPAGE
C : S_IRWXU + S_IROTH
C : AsciiCodePage)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
* Get file lock information
C Eval l_type = F_WRLCK
C Eval l_whence = SEEK_SET
C Eval ReturnInt = fcntl(FileDesc
C :F_GETLK
C :flock)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
* Close file
C Eval ReturnInt = close(FileDesc)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
* Testing with different open file type
C Eval FileDesc = open(FileName
C : O_TEXTDATA + O_RDWR)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
C Eval l_type = F_WRLCK
C Eval l_whence = SEEK_SET
C Eval ReturnInt = fcntl(FileDesc
C :F_GETLK
C :flock)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
C Eval ReturnInt = close(FileDesc)
C Eval p_errno = errnof
C If errno > 0
C Eval errno = 0
C EndIf
* Delete IFS file
C* CallP unlink(FileName)
C Eval *InLR = *On
C Return
* ================ End Calculation Specifications ==============
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
