Article

Source code for module P_IFS

John Blenkinsop
     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
=

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to: