Source code for module P_IFS

Source code for module P_IFS

This Content Component encountered an error
     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
=

Dig deeper on Integrated File System (IFS)

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close