// 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 |