News
Stay informed about the latest enterprise technology news and product updates.
Source code for module P_IFS
Source code for module P_IFS
H NoMain
H Option ( *NoDebugIO : *SrcStmt )
H ExprOpts ( *ResDecPos )
H BndDir ('QC2LE')
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Service program : IFS_PROCS
* Module : P_IFS
* Description : Procedures to handle files in the IFS
* Programmer : J L Blenkinsop
* Date : 20/01/2005
* Note : Original code by Scott Klement, iSeries News Jan 2005
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*CMD: CRTRPGMOD
*CRT: DBGVIEW(*ALL)
*END:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Procedures exported from this module
*
* IFS_Open Open an IFS file
*
* IFS_Close Close an IFS file
*
* IFS_LoadRec Load a record from the IFS file
*
* IFS_Copy Copy a file from one IFS directory to another (text mode)
*
* IFS_Move Move a file from one IFS directory to another
*
* IFS_ListDir Read file names from directory one by one. Use structure
* FileDesc (see below) in your program to receive the data
* about the file. The FileDesc.type field indicates which
* type of file information is being returned for :
*
* b Block special file
* c Character special file
* d Directory
* l Symbolic link
* p Pipe
* s Socket
* - Normal file
* E Error occurred - text is in FileDesc.name
*
* When a fatal error occurs, FileDesc.name contains the text
* of the error, and *Off is returned to the caller.
*
* The permissions flags, FileDesc.flags, are in three groups
* of three characters. In all groups, the characters mean :
*
* 1 r Readable file
* - Not a readable file
*
* 2 w Writeable file
* - Not a writeable file
*
* 3 S Set-User/Group-ID is set
* s Set-User/Group-ID is set; file is executable
* x File is executable, or directory is searchable
* - Not an executable file
*
* On every call, even the first, IFS_ListDir will return
* data. If the directory on subsequent calls is the same
* as that on the first call, no new directory listing is
* produced; the next object in the directory is returned.
*
* If you want to restart with the same directory, place
* the value '*NEW' into the FileDesc.name field before
* the call. This will get a fresh list of the directory.
*
* IFS_ListDir will not by default return non-object data
* except on error, when it returns the error message text
* in the FileDesc.name field, together with *Off on Eval.
*
* But you can ask it to return everything if on the first
* call you place the value '*ALL' into the FileDesc.name
* field. This acts like '*NEW' and will also cause this
* and subsequent calls to return any additional information
* that is available. For the moment, this is only the
* 'total bytes in directory' information. It is returned
* as text in FileDesc.name, and the size is returned as a
* numeric value in FileDesc.size.
*
* IFS_ListDir does NOT recurse directories.
*
* CSV_Config Configure options for CSV parsing (only use this if the
* standard delimiters are not , for the field and " for a
* string).
*
* CSV_GetFld Return the next parsed CSV field from the IFS record.
* Uses standard delimiters unless CSV_Config was executed.
* Characters in the incoming string can be excluded from
* the output using a fourth parameter.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
D*Dstart
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Data definitions and prototypes
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
D pFILE S * Based(prototype_only)
D IFSfile_t DS Qualified
D fp * Inz(*Null)
D buf 32767 Varying Inz('')
D bufpos 10I 0 Inz(*Zero)
D FileDesc DS Qualified
D type 1
D name 256 Varying
D size 20I 0
D date Z
D owner 10
D group 10
D flags 9
D owner_read 1 OverLay(Flags:1)
D owner_write 1 OverLay(Flags:2)
D owner_mode 1 OverLay(Flags:3)
D group_read 1 OverLay(Flags:4)
D group_write 1 OverLay(Flags:5)
D group_mode 1 OverLay(Flags:6)
D other_read 1 OverLay(Flags:7)
D other_write 1 OverLay(Flags:8)
D other_mode 1 OverLay(Flags:9)
D FileFlags DS 10
D FFtype 1
D FFothers 9
* ------------------------------------------------------------------------
* Global fields
* ------------------------------------------------------------------------
D g_FldDel S 1 Inz(',')
D g_StrDel S 1 Inz('"')
D c_FldDel S 1 Inz(',')
D c_StrDel S 1 Inz('"')
D CSV_Configure S N Inz(*Off)
* Convert month name to month number, and date conversion :
D DS
D aMonth 1 36 Dim(12)
D dMonth 1 36 Inz('JanFebMarAprMayJun-
D JulAugSepOctNovDec')
D Month S 3 Month name
D Time S 8 Time hh:mm:ss
D Char15 S 15
D DS
D Year 4S 0 Year
D iMonth 2S 0 Index to aMonth
D Day 2S 0 Day
D DateEur 1 8 Date in euro format
D DS
D WorkDateISO Z Inz(*Sys)
D WorkISODate D Overlay( WorkDateISO )
D WorkISOTime T Overlay( WorkDateISO : 12 )
* --------------------------------------------------------------
* Constants used by the spawn() API
* --------------------------------------------------------------
D SPAWN_SETSIGMASK...
D C 2
D SPAWN_SETSIGDEF...
D C 4
D SPAWN_SETPGROUP...
D C 8
D SPAWN_SETTHREAD_NP...
D C 16
D SPAWN_SETPJ_NP...
D C 32
D SPAWN_SETCOMPMSG_NP...
D C 64
D SPAWN_SETJOBNAMEPARENT_NP...
D C 128
D SPAWN_FDCLOSED...
D C -1
D SPAWN_NEWPGROUP...
D C -1
D SPAWN_MAX_NUM_ARGS...
D C 255
* Flag used for the "options" parameter of the waitpid() API :
D WNOHANG C 1
* Environment variable :
D c_UseDesc C 'QIBM_USE_DESCRIPTOR_STDIO=Y'
* Others :
D c_CmdList C '/usr/bin/ls'
D c_CmdCopy C '/usr/bin/cp'
D c_CmdMove C '/usr/bin/mv'
* --------------------------------------------------------------
* The inheritance structure tells the spawn() API which attributes
* should be inherited in the new job.
*
* struct inheritance {
* flagset_t flags;
* int pgroup;
* sigset_t sigmask;
* sigset_t sigdefault;
* };
* --------------------------------------------------------------
D flagset_t S 10U 0 Based(Template)
D pid_t S 10I 0 Based(Template)
D sigset_t S 20U 0 Based(Template)
D inheritance_t DS Based(Template)
D flags Like(flagset_t)
D pgroup Like(pid_t)
D sigmask Like(sigset_t)
D sigdefault Like(sigset_t)
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Global variables
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* QShell STDxxx pipes and associated variables :
D gPipeIn S 10I 0 Dim(2)
D gPipeOut S 10I 0 Dim(2)
D gPipeErr S 10I 0 Dim(2)
D gOut S *
D gErr S *
D gBuffer S 133
D pBuffer S *
D gLine S 132
D gFirstTime S N Inz(*On)
D gAllData S N Inz(*Off)
* Spawn API variables :
D gPID S Like(pid_t)
D gFD_count S 10I 0
D gFD_map S 10I 0 Dim(256)
D gInherit DS LikeDS(Inheritance_t)
D gDirectory S 1024 Copy of path
D aArg S 256 Dim(SPAWN_MAX_NUM_ARGS) Argument array
D gArg S * Dim(SPAWN_MAX_NUM_ARGS) Inz(*Null) Argument pointers
D gEnvVar S 256 Environment var.
D gEnv S * Dim(256) Inz(*Null) Environment pointers
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* IBM-supplied procedures used internally
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ------------------------------------------------------------------------
* spawn(): create a child process with inherited attributes
*
* pid_t spawn( const char *path,
* const int fd_count,
* const int fd_mapœ|,
* const struct inheritance *inherit,
* char * const argvœ|,
* char * const envpœ|);
*
* Returns the child's PID or -1 upon error
* ------------------------------------------------------------------------
D spawn PR ExtProc('spawn') Like(pid_t)
D path * Value Options(*String)
D fd_count 10I 0 Value
D fd_map 10I 0 Dim(256) Options(*VarSize:*Omit)
D inherit LikeDS(inheritance_t)
D argv * Dim(SPAWN_MAX_NUM_ARGS)
D Options(*VarSize)
D envp * Dim(256) Options(*VarSize)
* ------------------------------------------------------------------------
* spawnp(): create a child process with inherited attributes,
* find the child process using a PATH.
*
* pid_t spawnp( const char *path,
* const int fd_count,
* const int fd_mapœ|,
* const struct inheritance *inherit,
* char * const argvœ|,
* char * const envpœ|);
*
* Returns the child's PID or -1 upon error
* ------------------------------------------------------------------------
D spawnp PR ExtProc('spawnp') Like(pid_t)
D path * Value Options(*String)
D fd_count 10I 0 Value
D fd_map 10I 0 Dim(256) Options(*VarSize:*Omit)
D inherit LikeDS(inheritance_t)
D argv * Dim(SPAWN_MAX_NUM_ARGS)
D Options(*VarSize)
D envp * Dim(256) Options(*VarSize)
* ------------------------------------------------------------------------
* waitpid(): Wait for specific child process
*
* pid_t waitpid(pid_t pid, int *stat_loc, int options)
*
* This allows you to check the status of a spawned process, or
* wait for it to complete.
* ------------------------------------------------------------------------
D waitpid PR ExtProc('waitpid') Like(pid_t)
D pid Like(pid_t) Value
D stat_loc 10I 0
D options 10I 0 Value
* ------------------------------------------------------------------------
* pipe()--Create an Interprocess Channel
*
* int pipe(int fildesœ2|);
*
* returns 0 if successful, -1 if there's an error (errno is set)
* ------------------------------------------------------------------------
D pipe PR 10I 0 ExtProc('pipe')
D fildes 10I 0 Dim(2)
* ------------------------------------------------------------------------
* fopen Open File for buffered reading/writing
*
* filename = (input) path to file in the IFS
* mode = (input) various open mode flags. (see manual)
*
* returns *NULL upon error, or a pointer to a FILE structure
* ------------------------------------------------------------------------
D fopen PR ExtProc('_C_IFS_fopen')
D Like(pFILE)
D filename * Value Options(*string)
D mode * Value Options(*string)
* ------------------------------------------------------------------------
* fgets Read a string
*
* string = (output) string read (null-terminated)
* size = (input) maximum size that can be stored in string
* stream = (input) FILE structure to read data from
*
* returns a pointer to the string read from the file
* or *NULL upon EOF or error.
* ------------------------------------------------------------------------
D fgets PR * ExtProc('_C_IFS_fgets')
D string * Value
D size 10I 0 Value
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fputs Write string
*
* string = (input) string to write to file
* stream = (input) FILE structure designating the file to
* write to.
*
* returns a non-negative value if successful
* or -1 upon error
* ------------------------------------------------------------------------
D fputs PR 10I 0 ExtProc('_C_IFS_fputs')
D string * Value Options(*string)
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fread Read items
*
* data = (input) data items to read
* size = (input) size of each data item
* count = (input) number of data items
* stream = (input) pointer to FILE structure to read from
*
* returns the number of full items read, a short count
* indicates an error.
* ------------------------------------------------------------------------
D fread PR 10U 0 ExtProc('_C_IFS_fread')
D data * Value
D size 10U 0 Value
D count 10U 0 Value
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fwrite Write items
*
* data = (input) data items to write
* size = (input) size of each data item
* count = (input) number of data items
* stream = (input) pointer to FILE structure to write to
*
* returns the number of full items written. A short count
* indicates an error.
* ------------------------------------------------------------------------
D fwrite PR 10U 0 ExtProc('_C_IFS_fwrite')
D data * Value
D size 10U 0 Value
D count 10U 0 Value
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fflush Flush a stream
*
* stream = (input) pointer to FILE structure to flush
*
* returns 0 if successful, -1 otherwise
* ------------------------------------------------------------------------
D fflush PR 10U 0 ExtProc('_C_IFS_fflush')
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* close Close a File Descriptor
*
* fildes = (input) File descriptor
* ------------------------------------------------------------------------
D close PR 10I 0 ExtProc('close')
D fildes 10I 0 Value
* ------------------------------------------------------------------------
* fclose Close File
*
* stream = (input) pointer to FILE structure to close
* ------------------------------------------------------------------------
D fclose PR 10I 0 ExtProc('_C_IFS_fclose')
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fseek Reposition a file
*
* stream = (input) pointer to FILE structure to reposition
* offset = (input) offset from "whence" in bytes
* whence = (input) position to begin offset at, can be
* SEEK_SET, SEEK_END or SEEK_CUR
*
* returns 0 if successful, -1 otherwise
* ------------------------------------------------------------------------
D fseek PR 10I 0 ExtProc('_C_IFS_fseek')
D stream Like(pFILE) Value
D offset 10I 0 Value
D whence 10I 0 Value
* ------------------------------------------------------------------------
* ftell Get Current position
*
* stream = (input) pointer to FILE structure
*
* returns the file position, or -1 upon error
* ------------------------------------------------------------------------
D ftell PR 10I 0 ExtProc('_C_IFS_ftell')
D stream Like(pFILE) Value
* ------------------------------------------------------------------------
* fdopen Upgrade a file descriptor to a buffered stream
*
* fildes = (input) file descriptor to upgrade
* mode = (input) mode, equivalent to the mode specified
* on the fopen API, except that it must be
* compatible with the flags that were used on
* the open API.
*
* Returns a new pointer to a buffered stream I/O file
* or *NULL upon error.
* ------------------------------------------------------------------------
D fdopen PR * ExtProc('fdopen')
D fildes 10I 0 Value
D mode * Value Options(*string)
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Non-IBM procedures external to this module
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
D Pull PR 50 ->Return string
D p_TxtStr 1024 Options(*VarSize) Const Text string
D p_TxtLen 5U 0 Value Length of string
D p_TxtWrd 5U 0 Value Word to return
D p_Delim 30 Options(*NoPass) Value Delimiter characters
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Procedures exported from this module
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ------------------------------------------------------------------------
* IFS_open Open a delimited text file
*
* peFilename = (input) IFS pathname to file to open
*
* Returns an IFSfile_t data structure or an *ESCAPE message on error
* ------------------------------------------------------------------------
D IFS_open PR Likeds(IFSfile_t)
D peFilename 1024A Varying Const Options(*VarSize)
* ------------------------------------------------------------------------
* IFS_close Close file
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
*
* ------------------------------------------------------------------------
D IFS_close PR
D sIFS Likeds(IFSfile_t)
* ------------------------------------------------------------------------
* IFS_LoadRec Load a record from a delimited file into memory
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
*
* Returns *ON if successful, *OFF upon failure or EOF
* ------------------------------------------------------------------------
D IFS_LoadRec PR 1N
D sIFS Likeds(IFSfile_t)
* ------------------------------------------------------------------------
* IFS_Copy Copy a file in text mode, with translation, from the IFS.
*
* pePath = (input) IFS pathname including file
* peToFile = (input) IFS pathname including file
*
* To copy to the QSYS environment, peToFile must begin 'QSYS.LIB/'.
*
* Returns *ON if successful, *OFF upon failure
* ------------------------------------------------------------------------
D IFS_Copy PR 1N
D pePath 1024A Varying Const Options(*VarSize)
D peToFile 1024A Varying Const Options(*VarSize)
* ------------------------------------------------------------------------
* IFS_Move Move a file from one IFS directory to another
*
* peFromFile = (input) IFS pathname including file
* peToPath = (input) IFS pathname (may include a file name)
*
* To copy to the QSYS environment, peToFile must begin 'QSYS.LIB/'.
*
* Returns *ON if successful, *OFF upon failure
* ------------------------------------------------------------------------
D IFS_Move PR 1N
D peFromFile 1024A Varying Const Options(*VarSize)
D peToPath 1024A Varying Const Options(*VarSize)
* ------------------------------------------------------------------------
* IFS_ListDir Read files names from directory one by one
*
* peDirectory = (input) IFS pathname to directory
* sFileDtl = (out) IFS file name & details structure
*
* Returns *ON if successful, *OFF upon failure or end of data.
* ------------------------------------------------------------------------
D IFS_ListDir PR 1N
D peDirectory 1024A Varying Const Options(*VarSize)
D sFileDtl Likeds(FileDesc)
* ------------------------------------------------------------------------
* CSV_Config Configure CSV options
*
* peFldDel = (input) Field delimiter
* peStrDel = (input) String delimiter
*
* Returns no values
* ------------------------------------------------------------------------
D CSV_Config PR
D peFldDel 1 Const
D peStrDel 1 Const
* ------------------------------------------------------------------------
* CSV_getfld Get the next field from a CSV delimited record
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
* peVarSize = (input) Size, in bytes, of the variable passed.
* peExclude = (input/omit) Characters to exclude
* if not passed, no characters are excluded.
*
* Returns extracted field value
* ------------------------------------------------------------------------
D CSV_getfld PR 32767
D sIFS Likeds(IFSfile_t)
D peVarSize 10I 0 Value
D peExclude 10 Const Varying Options(*NoPass)
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Procedures created in this module and used internally
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
D WIFexited PR 1N
D Status 10I 0 Value
D WexitStatus PR 10I 0
D Status 10I 0 Value
D CvtToNum PR 15S 0
D Char15 15 Value
D ReportError PR
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
* * * * * * P R O C E D U R E S * * * * * *
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ------------------------------------------------------------------------
* IFS_open Open a delimited text file
*
* peFilename = (input) IFS pathname to file to open
*
* returns a IFSfile_t data structure
* or an *ESCAPE message upon error
* ------------------------------------------------------------------------
P IFS_open B Export
D IFS_open PI Likeds(IFSfile_t)
D peFilename 1024A Varying Const Options(*varsize)
D sFile DS Likeds(IFSfile_t)
D Inz(*LikeDS)
* Calculations :
C Eval sFile.fp = fopen(peFilename : 'r')
C If sFile.fp = *Null
C CallP ReportError
C EndIf
C Eval sFile.buf = ''
C Eval sFile.bufpos = 1
C Return sFile
P IFS_open E
* ------------------------------------------------------------------------
* IFS_close Close file
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
*
* ------------------------------------------------------------------------
P IFS_close B Export
D IFS_close PI
D sIFS Likeds(IFSfile_t)
* Calculations :
C If fclose(sIFS.fp) <> 0
C CallP (E) ReportError
C EndIf
P IFS_close E
* ------------------------------------------------------------------------
* IFS_loadrec Load a record into memory
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
*
* Returns *ON if successful, *OFF upon failure or EOF
* ------------------------------------------------------------------------
P IFS_loadrec B Export
D IFS_loadrec PI 1N
D sIFS Likeds(IFSfile_t)
D buf S 32767A
D p_buf S *
D len S 10I 0
* Calculations :
C Eval p_buf = fgets(%Addr(buf):%Size(buf):sIFS.fp)
C If p_buf = *Null
C Return *Off
C EndIf
C Eval sIFS.buf = %Str(p_buf)
C Eval len = %Len(sIFS.buf)
C If %SubSt(sIFS.buf : len : 1) = x'25'
C Eval len = len - 1
C Eval %Len(sIFS.buf) = len
C EndIf
C If %SubSt(sIFS.buf : len : 1) = x'0D'
C Eval len = len - 1
C Eval %Len(sIFS.buf) = len
C EndIf
C Eval sIFS.bufpos = 1
C Return *On
P IFS_loadrec E
* ------------------------------------------------------------------------
* IFS_Copy Copy a file in text mode, with translation, from the IFS.
*
* pePath = (input) IFS pathname including file
* peToFile = (input) IFS pathname including file
*
* To copy to the QSYS environment, peToFile must begin 'QSYS.LIB/'.
*
* Returns *ON if successful, *OFF upon failure
* ------------------------------------------------------------------------
P IFS_Copy B Export
D IFS_Copy PI 1N
D pePath 1024A Varying Const Options(*VarSize)
D peToFile 1024A Varying Const Options(*VarSize)
D lPID S Like(pid_t)
D lFD_count S 10I 0 Inz(*Zero)
D lFD_map S 10I 0 Inz(*Zero)
D lInherit DS LikeDS(Inheritance_t)
D lArg S 256 Dim(5) Argument array
D pArg S * Dim(5) Argument pointers
D lEnvVar S 256 Environment var.
D pEnv S * Dim(1) Inz(*Null) Environment pointers
* ------------
* Calculations
* ------------
* Set up the parameters for the QShell call :
C Eval lInherit = *Allx'00'
C Eval lArg (1) = c_CmdCopy + x'00'
C Eval lArg (2) = '-t' + x'00'
C Eval lArg (3) = %TrimR(pePath) + x'00'
C Eval lArg (4) = %TrimR(peToFile) + x'00'
C Eval pArg (1) = %Addr(lArg (1))
C Eval pArg (2) = %Addr(lArg (2))
C Eval pArg (3) = %Addr(lArg (3))
C Eval pArg (4) = %Addr(lArg (4))
C Eval pArg (5) = *Null
* Spawn the QSHELL job :
C Eval lPID = spawn( lArg (1)
C : lFD_count
C : lFD_map
C : lInherit
C : pArg
C : pEnv )
C Return *On
P IFS_Copy E
* ------------------------------------------------------------------------
* IFS_Move Move a file from one IFS directory to another
*
* peFromFile = (input) IFS pathname including file
* peToPath = (input) IFS pathname (may include a file name)
*
* To copy to the QSYS environment, peToFile must begin 'QSYS.LIB/'.
*
* Returns *ON if successful, *OFF upon failure
* ------------------------------------------------------------------------
P IFS_Move B Export
D IFS_Move PI 1N
D peFromFile 1024A Varying Const Options(*VarSize)
D peToPath 1024A Varying Const Options(*VarSize)
D lPID S Like(pid_t)
D lFD_count S 10I 0 Inz(*Zero)
D lFD_map S 10I 0 Inz(*Zero)
D lInherit DS LikeDS(Inheritance_t)
D lArg S 256 Dim(5) Argument array
D pArg S * Dim(5) Argument pointers
D lEnvVar S 256 Environment var.
D pEnv S * Dim(1) Inz(*Null) Environment pointers
* ------------
* Calculations
* ------------
* Set up the parameters for the QShell call :
C Eval lInherit = *Allx'00'
C Eval lArg (1) = c_CmdMove + x'00'
C Eval lArg (2) = %TrimR(peFromFile) + x'00'
C Eval lArg (3) = %TrimR(peToPath) + x'00'
C Eval pArg (1) = %Addr(lArg (1))
C Eval pArg (2) = %Addr(lArg (2))
C Eval pArg (3) = %Addr(lArg (3))
C Eval pArg (4) = *Null
* Spawn the QSHELL job :
C Eval lPID = spawn( lArg (1)
C : lFD_count
C : lFD_map
C : lInherit
C : pArg
C : pEnv )
C Return *On
P IFS_Move E
* ------------------------------------------------------------------------
* IFS_ListDir Read file names from directory one by one
*
* peDirectory = (input) IFS pathname to directory
* sFileDtl = (out) IFS file name & details structure
*
* Returns *ON if successful, *OFF upon failure or end of data.
* ------------------------------------------------------------------------
P IFS_ListDir B Export
D IFS_ListDir PI 1N
D peDirectory 1024A Varying Const Options(*VarSize)
D sFileDtl Likeds(FileDesc)
* ------------
* Calculations
* ------------
* ----------------------------
* If path changes, start again
* ----------------------------
C If gFirstTime or gDirectory <> peDirectory
C or sFileDtl.name = '*NEW'
C or sFileDtl.name = '*ALL'
C If sFileDtl.name = '*ALL'
C Eval gAllData = *On
C Else
C Eval gAllData = *Off
C EndIf
C Eval gFirstTime = *On
C Eval gDirectory = *Blank
* Create the pipes :
C If Pipe(gPipeIn) < *Zero
C CallP ReportError
C EndIf
C If Pipe(gPipeOut) < *Zero
C CallP Close(gPipeIn(1))
C CallP Close(gPipeIn(2))
C CallP ReportError
C EndIf
C If Pipe(gPipeErr) < *Zero
C CallP Close(gPipeIn(1))
C CallP Close(gPipeIn(2))
C CallP Close(gPipeOut(1))
C CallP Close(gPipeOut(2))
C CallP ReportError
C EndIf
* Use descriptors for standard input & output :
C Eval gEnvVar = c_UseDesc + X'00'
C Eval gEnv (1) = %Addr(gEnvVar)
C Eval gEnv (2) = *Null
* Map the pipes to the descriptors :
C Eval gFD_map (1) = gPipeIn (1)
C Eval gFD_map (2) = gPipeOut (2)
C Eval gFD_map (3) = gPipeErr (2)
C Eval gFD_count = 3
* Set up the parameters for the QShell call :
C Eval gInherit = *Allx'00'
C Eval aArg (1) = c_CmdList + x'00'
C Eval aArg (2) = '-ATl' + x'00'
C Eval aArg (3) = %TrimR(peDirectory) + x'00'
C Eval gArg (1) = %Addr(aArg (1))
C Eval gArg (2) = %Addr(aArg (2))
C Eval gArg (3) = %Addr(aArg (3))
C Eval gArg (4) = *Null
* Spawn the QSHELL job :
C Eval gPID = spawn( aArg (1)
C : gFD_count
C : gFD_map
C : gInherit
C : gArg
C : gEnv )
C If gPID < *Zero
C CallP Close(gPipeIn (1))
C CallP Close(gPipeIn (2))
C CallP Close(gPipeOut(1))
C CallP Close(gPipeOut(2))
C CallP Close(gPipeErr(1))
C CallP Close(gPipeErr(2))
C CallP ReportError
C EndIf
* Close the pipes that are no longer used :
C CallP Close(gPipeIn (1))
C CallP Close(gPipeOut(2))
C CallP Close(gPipeErr(2))
C CallP Close(gPipeIn (2))
* Upgrade the output pipes to use ILE C buffered I/O :
C Eval gOut = fdopen( gPipeOut (1) : 'r' )
C Eval gErr = fdopen( gPipeErr (1) : 'r' )
* Check for errors :
C Eval pBuffer = fgets( %Addr(gBuffer)
C : %Size(gBuffer)
C : gErr )
C If pBuffer <> *Null
C Clear sFileDtl
C Eval sFileDtl.type = 'E'
C Eval sFileDtl.name = %Str( pBuffer )
C CallP fclose( gOut )
C CallP fclose( gErr )
C Return *Off
C EndIf
* Copy the incoming parameters and end this phase :
C Eval gDirectory = peDirectory
C Eval gFirstTime = *Off
C EndIf
* --------------------------------------------
* Read a single file detail line from the pipe
* --------------------------------------------
C Clear sFileDtl
* -----------------
C TryAgain Tag
* -----------------
C Eval pBuffer = fgets( %Addr(gBuffer)
C : %Size(gBuffer)
C : gOut )
* End of data; return end of data flag :
C If pBuffer = *Null
C CallP fclose( gOut )
C CallP fclose( gErr )
C Return *Off
C EndIf
* Fill the output structure :
C Eval gLine = %Str( pBuffer )
C Eval FileFlags = Pull( gLine : 132 : 1 )
C Eval sFileDtl.type = FFtype
C Eval sFileDtl.flags = FFothers
* If this is the 'total bytes' line, exclude it unless all data wanted :
C If FileFlags = 'total:'
C If not gAllData
C GoTo TryAgain
C EndIf
C Eval sFileDtl.type = 'I'
C Eval sFileDtl.name = %TrimR(gLine)
C Eval %Len(sFileDtl.name) =
C %Len(%TrimR(sFileDtl.name))
C Eval %Subst(sFileDtl.name:%Len(sFileDtl.name):1) =
C *Blank
C Eval %Len(sFileDtl.name) =
C %Len(%TrimR(sFileDtl.name))
C Eval Char15 = Pull( gLine : 132 : 2 )
C Eval sFileDtl.size = CvtToNum(Char15)
C Return *On
C EndIf
* Normal line (file or directory). Fill in the output structure and return data :
C Eval sFileDtl.owner = Pull( gLine : 132 : 3 )
C Eval sFileDtl.group = Pull( gLine : 132 : 4 )
C Eval Char15 = Pull( gLine : 132 : 5 )
C Eval sFileDtl.size = CvtToNum(Char15)
C Eval Month = Pull( gLine : 132 : 6 )
C Eval Char15 = Pull( gLine : 132 : 7 )
C Eval Day = CvtToNum(Char15)
C Eval Time = Pull( gLine : 132 : 8 )
C Eval Char15 = Pull( gLine : 132 : 9 )
C Eval Year = CvtToNum(Char15)
* Assemble the date and time :
C Eval iMonth = 1
C Month LookUp aMonth(iMonth) 01
C *ISO0 Move DateEur WorkISOdate
C *HMS: Move Time WorkISOtime
C Eval sFileDtl.date = WorkDateISO
* Assemble the file name. It will end with X'25', so we must get rid
* of that, then set the length to the actual length of the name :
C Eval sFileDtl.name = Pull( gLine : 132 : 10 )
C Eval %Len(sFileDtl.name) =
C %Len(%TrimR(sFileDtl.name))
C Eval %Subst(sFileDtl.name:%Len(sFileDtl.name):1) =
C *Blank
C Eval %Len(sFileDtl.name) =
C %Len(%TrimR(sFileDtl.name))
C Return *On
P IFS_ListDir E
* ------------------------------------------------------------------------
* CSV_Config Configure CSV options
*
* peFldDel = (input) Field delimiter
* peStrDel = (input) String delimiter
*
* Returns no values
* ------------------------------------------------------------------------
P CSV_Config B Export
D CSV_Config PI
D peFldDel 1 Const
D peStrDel 1 Const
* ------------
* Calculations
* ------------
C Eval CSV_Configure = *On
C Eval c_FldDel = peFldDel
C Eval c_StrDel = peStrDel
P CSV_Config E
* ------------------------------------------------------------------------
* CSV_GetFld Get the next field from a CSV delimited file record
*
* sIFS = (i/o) IFSfile_t DS returned by IFS_open
* peVarSize = (input) size, in bytes, of the variable to be filled.
*
* Returns the extracted field data
* ------------------------------------------------------------------------
P CSV_getfld B Export
D CSV_getfld PI 32767
D sIFS Likeds(IFSfile_t)
D peVarSize 10I 0 Value
D peExclude 10 Const Varying Options(*NoPass)
D CList S 10
D CL S 10I 0
D P1 S 10I 0
D Exclude S 1N
D RtnDta S 32767 Varying
D max S 10I 0
D len S 10I 0
D start S 10I 0
D pos S 10I 0
D inString S 1N
D char S 1
D FldDel S 1
D StrDel S 1
* ------------
* Calculations
* ------------
* Use global or configured delimiters :
C If CSV_Configure
C Eval FldDel = c_FldDel
C Eval StrDel = c_StrDel
C Else
C Eval FldDel = g_FldDel
C Eval StrDel = g_StrDel
C EndIf
* Set up check for excluded characters :
C If %Parms > 2
C Eval CL = %Len(peExclude)
C Eval CList = peExclude
C Else
C Eval CL = *Zero
C EndIf
* Start at end of last field read and read next delimited field :
C Eval max = peVarSize - 2
C Eval len = %Len(sIFS.buf)
C Eval start = sIFS.bufpos
C Eval RtnDta = ''
C Eval %Len(RtnDta)= *Zero
C For pos = start to len
C Eval char = %SubSt(sIFS.buf : pos : 1)
C Select
* End of delimited string :
C When inString and char = StrDel
C Eval inString = *Off
* End of delimited field :
C When not inString and char = FldDel
C Eval sIFS.bufpos = pos + 1
C Leave
* Start of delimited string :
C When not inString and char = StrDel
C Eval inString = *On
* Past end of returnable field length -- extra characters are discarded :
C When %Len(RtnDta) >= max
* No excluded characters; add this character to the output :
C When CL = *Zero
C Eval RtnDta = RtnDta + char
* Check for excluded characters; add valid character to the output :
C Other
C Eval Exclude = *Off
C For P1 = 1 to CL
C If char = %Subst(CList:P1:1)
C Eval Exclude = *On
C Leave
C EndIf
C EndFor
C If not Exclude
C Eval RtnDta = RtnDta + char
C EndIf
C EndSl
C EndFor
C Return RtnDta
P CSV_getfld E
* ------------------------------------------------------------------------
* ReportError Send an escape message explaining any errors
* that occurred.
*
* This function requires binding directory QC2LE in order
* to access the __errno function.
* ------------------------------------------------------------------------
P ReportError B
D ReportError PI
D get_errno PR * ExtProc('__errno')
D QMHSNDPM PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 1A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 8192A Options(*varsize)
D ErrorCode DS qualified
D BytesProv 1 4I 0 Inz(0)
D BytesAvail 5 8I 0 Inz(0)
D ptrToErrno S *
D errno S 10I 0 Based(ptrToErrno)
D MsgKey S 4
D MsgID S 7
* Calculations :
C Eval ptrToErrno = get_errno
C Eval MsgID = 'CPE' + %Char(errno)
C CallP (E) QMHSNDPM( MsgID
C : 'QCPFMSG *LIBL'
C : ' '
C : 0
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ErrorCode )
P ReportError E
* ------------------------------------------------------------------------
* Check if child process terminated normally
*
* status = (input) exit status code from waitpid() API
*
* Returns *ON if child exited normally, *OFF otherwise.
* ------------------------------------------------------------------------
P WIFexited B
D WIFexited PI 1N
D status 10I 0 value
D dsIntVal ds
D IntVal 10I 0
C Eval dsIntVal = x'FFFF0000'
C If %BitAnd( status : IntVal ) = 0
C Return *On
C Else
C Return *Off
C EndIf
P WIFexited E
* ------------------------------------------------------------------------
* Check the exit status of the child process. This is useful for
* checking QShell results.
*
* status = (input) exit status code from waitpid() API
*
* Returns *ON if child exited normally, *OFF otherwise ???? Don't think so]
* ------------------------------------------------------------------------
P WexitStatus B
D WexitStatus PI 10I 0
D status 10I 0 Value
D dsIntVal DS
D IntVal 10I 0
C If WIFexited(status)
C Eval dsIntVal = x'000000FF'
C Return %BitAnd( status : IntVal )
C Else
C Return -1
C EndIf
P WexitStatus E
* ------------------------------------------------------------------------
* Convert character to number (no sign, no commas or decimals)
* ------------------------------------------------------------------------
P CvtToNum B
D CvtToNum PI 15S 0
D Char15 15 Value
D P1 S 10I 0
D P2 S 10I 0
D P3 S 10I 0
D DS
D Num15c 1 15
D Num15 1 15S 0
C Eval P1 = %Len(%TrimR(Char15))
C If P1 = *Zero
C Return *Zero
C EndIf
C If P1 = 15
C Eval Num15c = Char15
C Return Num15
C EndIf
C Eval P2 = 16 - P1
C Eval Num15 = *Zero
C For P3 = 1 to P1
C Eval %Subst(Num15c:P2:1) =
C %Subst(Char15:P3:1)
C Eval P2 = P2 + 1
C EndFor
C Return Num15
P CvtToNum E
=
Start the conversation
0 comments