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 =