BoTTom |
      //  Maximum length of IFS records is 32740 chars
      //  Records will be terminated by the windows-style CR/LF sequence
      //  Character fields are enclosed within double quotes (")
      //    and trailing blanks are removed
      //  Numeric and date fields are output as-is.
 
      // ATENTION : EN V6R10 il faut (en plus de 5733OAR)
      //  SI39480 sur 5761SS1 et SI39912 sur 5761WDS
 
     H DftActGrp(*No) Option(*SrcStmt)
 
       // Standard IBM supplied Open Access definitions
      /copy QOAR/QRPGLESRC,QRNOPENACC
       // Definition of additional handler parameter and constants
      /copy AF4SRCT/EXEMPLEOAR,cvs_cpy
       // Standard IBM supplied IFS prototypes
      /copy qsysinc/qrpglesrc,ifs
       // RPG Status code values
      /copy AF4SRCT/EXEMPLEOAR,status
 
      // On V7 and later systems this PR can be removed and so can those for
      //   local subprocedures openFile(), writeFile() and closeFile().
     D CVS_HDLRI       pr                  ExtPgm('CVS_HDLRI')
     D   info                              likeds(QrnOpenAccess_T)
 
      // Definitions for local subprocedures
     D openFile        pr                  like(fileHandle)
     D   path                              like(ifs_hdlr_info_t.path)
     D                                     const
 
     D readFile        pr                  like(filehandle)
     D   handle                            like(fileHandle) value
 
     D closeFile       pr
     D   handle                            like(fileHandle) value
 
     D CVS_HDLRI       PI
     D   info                              likeds(QrnOpenAccess_T)
 
     D readline        PR            10I 0
     D   fd                          10I 0 value
     D   text                          *   value
     D   maxlen                      10I 0 value
 


|
      // Field Names/Values structures
     D nvInput         ds                  likeds(QrnNamesValues_T)
     D                                     based(pNvInput)
 
      // Structure to map the "additional informatin" parameter passed
      //   by the RPG program. In this case it contains the IFS file name.
      //   Its pointer is contained within the userArea field in the info struct
     D ifs_info        ds                  likeds(ifs_hdlr_info_t)
     D                                     based(pIfs_info)
 
      // Used by the IFS routines to determine which IFS file is to be used
      //   Maps to storage dynamically allocated when opening the file.
      //   Pointer is stored in the rpgStatus field in the info structure
     D fileHandle      s             10i 0 based(pfileHandle)
 
      /free
         // Use the pointers in the info area to set up access to the
         //   the handle for the IFS file (stateInfo)
         //   and the IFS file name (userArea)
         pfileHandle = info.stateInfo;
 
         pIfs_info = info.userArea;
 
         If info.rpgOperation = QrnOperation_READ;
            // Set up access to Name/Value information
             pNvInput = info.namesValues;
 
            // Write error is unlikely but signal it if it occurs
            If ( readFile(fileHandle) = fileError );
               info.rpgStatus = errIO;
            EndIf;
 
         elseIf info.rpgOperation = QrnOperation_OPEN;
            // Specify that we want to use Name/Value information
            info.useNamesValues = *On;
 
            // Allocate the storage for the file handle and store the pointer
            //   in the info area. That way RPG can associate the pointer with
            //   the specific file and give it back to us on each operation.
            pfileHandle = %Alloc(%Size(fileHandle));
            info.stateInfo = pfileHandle;
 
            // Ensure that file handle is zero before attempting open()
            clear fileHandle;


|
 
            fileHandle = openFile (ifs_info.path); // Open file
            if fileHandle = fileNotOpen;
              info.rpgStatus = errImpOpenClose; // Open failed
            EndIf;
 
         elseif info.rpgOperation = QrnOperation_CLOSE;
            closeFile (fileHandle);
 
            // free the state information and null out the info pointer
            dealloc(n) pfileHandle;
            info.stateInfo = *null;
 
         else;
            // Any other operation is unsupported so notify RPG
            info.rpgStatus = 1299;  // general error status
         endif;
 
       Return;
 
      /end-free
 
 
     P openFile        b
     D openFile        pi                  like(fileHandle)
     D   path                              like(ifs_hdlr_info_t.path)
     D                                     const
 
      /free
         return open( path : O_RDONLY+O_TEXTDATA);
      /end-free
 
     P openFile        e
 
     P closeFile       b
     D closeFile       pi
     D   handle                            like(fileHandle) value
     D rc              s             10i 0
 
      /free
 
         rc = close (handle);
 
      /end-free


|
 
 
     P closeFile       e
 
     P readFile        b
     D                 pi                  like(filehandle)
     D   handle                            like(fileHandle) value
 
     D buffer          s          32740a
     D value           s          32470a   Based(pvalue)
     D reply           s             10i 0
     D i               s              5i 0
     D debut           S              5i 0
     D fin             S              5i 0
     D comma           c                   ';'
     D quote           c                   '"'
     D CRLF            c                   X'0D25'
     D zone            s          32740a   Varying
 
      /free
 
       reply = readline(handle: %addr(buffer): %size(buffer)) ;
       if reply < 1;
           info.eof = *ON;
           return 0;
       ENDIF;
 
       debut = 0;
       fin = 0;
       // Process all fields in record
       For i = 1 to nvInput.num;
         pvalue = nvInput.field(i).value; // mise en place pointeur
 
         // recherche zone suivante dans le buffer
         debut = fin + 1;
         fin = %scan(comma : buffer : debut);
         if fin = 0;
            fin = %len(%trimr(buffer)) + 1;
         endif;
           zone = %subst(buffer : debut : fin - debut);
 
         If ( nvInput.field(i).dataType = QrnDatatype_Alpha )
         Or ( nvInput.field(i).dataType = QrnDatatype_AlphaVarying);
           zone = %trim(zone : quote);


|
         EndIf;
 
         %subst( value: 1: nvInput.field(i).valueLenBytes ) = zone;
 
       EndFor;
 
       Return reply;
 
      /end-free
     P readFile        e
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *  This one's a bit more complicated.
      *     a) We don't know how long the text will go before
      *         an end-of-line sequence is encountered.
      *     b) We could just read one byte at a time until we found
      *         the EOL sequence, but that would run very slowly
      *         since it's inefficient to transfer chunks of data
      *         that small from disk.
      *
      *  So...  we keep a "read buffer".  We load chunks of data
      *  from disk into the buffer, then get one character at a
      *  time from that buffer.
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P readline        B
     D readline        PI            10I 0
     D   fd                          10I 0 value
     D   text                          *   value
     D   maxlen                      10I 0 value
 
     D rdbuf           S           1024A   static
     D rdpos           S             10I 0 static
     D rdlen           S             10I 0 static
 
     D p_retstr        S               *
     D RetStr          S          32766A   based(p_retstr)
     D len             S             10I 0
 
     c                   eval      len = 0
     c                   eval      p_retstr = text
     c                   eval      %subst(RetStr:1:MaxLen) = *blanks
 
     c                   dow       1 = 1
 
     C* Load the buffer


|
     c                   if        rdpos>=rdlen
     c                   eval      rdpos = 0
     c                   eval      rdlen=read(fd:%addr(rdbuf):%size(rdbuf))
     c                   if        rdlen < 1
     c                   return    -1
     c                   endif
     c                   endif
 
     C* Is this the end of the line?
     c                   eval      rdpos = rdpos + 1
     c                   if        %subst(rdbuf:rdpos:1) = x'25'
     c                   return    len
     c                   endif
 
     C* Otherwise, add it to the text string.
     c                   if        %subst(rdbuf:rdpos:1) <> x'0d'
     c                               and len<maxlen
     c                   eval      len = len + 1
     c                   eval      %subst(retstr:len:1) =
     c                               %subst(rdbuf:rdpos:1)
     c                   endif
 
     c                   enddo
 
     c                   return    len
     P                 E




©AF400