In this example, a handler allows an RPG programmer to read a stream file in the Integrated File System.
/IF DEFINED(IFSHDLRS_COPIED)
/EOF
/ENDIF
/DEFINE IFSHDLRS_COPIED
DCL-DS ifshdlrs_info_t QUALIFIED TEMPLATE;
path VARCHAR(5000);
createCcsid INT(10);
append IND;
END-DS;
DCL-C ifshdlrs_write_handler 'IFSHDLRS/WRITEHDLR';
The following shows the RPG program that defines the Open Access file.
A R STREAMFMT
A LINE 32740A VARLEN
CTL-OPT DFTACTGRP(*NO) ACTGRP(*NEW);
/copy IFSHDLRS/SRC,RPG 1
DCL-DS ifs_info LIKEDS(ifshdlrs_info_t); 2
DCL-F streamfile DISK(*EXT) USAGE(*OUTPUT) 3
EXTDESC('MYLIB/MYSTMF')
HANDLER(ifshdlrs_write_handler 4a
: ifs_info) 4b
USROPN;
ifs_info.path = '/home/mydir/myfile.txt'; 5
ifs_info.createCcsid = 0; // job CCSID
ifs_info.append = *ON;
OPEN streamfile;
line = 'Hello'; 6
WRITE streamFmt;
line = 'world!';
WRITE streamFmt;
*inlr = '1';
The following examples show the handler.
CTL-OPT DFTACTGRP(*NO) ACTGRP(*CALLER)
MAIN(writeHdlr);
/COPY IFSHDLRS/SRC,RPG
/COPY QOAR/QRPGLESRC,QRNOPENACC
/COPY QSYSINC/QRPGLESRC,IFS
DCL-S descriptor_t INT(10) TEMPLATE;
DCL-DS state_t QUALIFIED template; 1
descriptor LIKE(descriptor_t);
END-DS;
DCL-PROC writeHdlr;
DCL-PI *N EXTPGM; 1
parm LIKEDS(QrnOpenAccess_T);
END-PI;
DCL-S stackOffsetToRpg INT(10) INZ(2);
DCL-S errnoVal INT(10);
DCL-DS state LIKEDS(state_t) BASED(pState); 2
DCL-DS ifsInfo LIKEDS(ifshdlrs_info_t) BASED(pIfsInfo);
DCL-DS namesValues LIKEDS(QrnNamesValues_T)
BASED(parm.namesValues);
pState = parm.stateInfo; 3
pIfsInfo = parm.userArea;
SELECT;
WHEN parm.RpgOperation = QrnOperation_OPEN; 4
pState = %ALLOC(%SIZE(state_t));
parm.stateInfo = pState;
state.descriptor = openFile (ifsInfo
: stackOffsetToRpg + 1);
IF parm.externallyDescribed;
parm.useNamesValues = '1';
ENDIF;
WHEN parm.RpgOperation = QrnOperation_WRITE; 5
IF parm.useNamesValues;
writeFileNv (state.handle
: namesValues
: stackOffsetToRpg + 1);
ELSE:
writeFileBuf (state.handle
: parm.outputBuffer
: parm.outputBufferLen
: stackOffsetToRpg + 1);
ENDIF;
WHEN parm.RpgOperation = QrnOperation_CLOSE; 6
closeFile (state.handle
: stackOffsetToRpg + 1);
state.descriptor = -1;
DEALLOC(N) pState;
OTHER; 7
sendException ('Unexpected operation '
+ %CHAR(parm.RpgOperation)
: stackOffsetToRpg + 1);
// Control will not return here
ENDSL;
END-PROC writeHdlr;
DCL-PROC openFile;
DCL-PI *n LIKE(descriptor_t);
ifsInfo LIKEDS(ifshdlrs_info_t) CONST;
stackOffsetToRpg INT(10) VALUE;
END-PI;
DCL-C JOB_CCSID 0;
DCL-S openFlags INT(10);
DCL-S descriptor LIKE(descriptor_t);
openFlags = O_WRONLY
+ O_CREAT + O_TEXT_CREAT + O_TEXTDATA
+ O_CCSID + O_INHERITMODE;
IF ifsInfo.append;
openFlags += O_APPEND;
ELSE:
openFlags += O_TRUNC;
ENDIF;
descriptor = open(ifsInfo.path
: openFlags
: 0
: ifsInfo.createCcsid
: JOB_CCSID);
IF descriptor < 0; 1
errnoException ('Could not open ' + ifsInfo.path + '.'
: getErrno ()
: stackOffsetToRpg + 1);
// Control will not return here
ENDIF;
return descriptor;
END-PROC openFile;
DCL-PROC closeFile;
DCL-PI *n;
descriptor LIKE(descriptor_t) VALUE;
stackOffsetToRpg INT(10) VALUE;
END-PI;
DCL-S rc INT(10);
rc = close (descriptor);
IF rc < 0;
errnoException ('Error closing file.'
: getErrno ()
: stackOffsetToRpg + 1);
// Control will not return here
ENDIF;
END-PROC closeFile;
DCL-PROC writeFileBuf;
DCL-PI *n;
descriptor LIKE(descriptor_t) VALUE;
pBuf pointer VALUE;
bufLen INT(10) VALUE;
stackOffsetToRpg INT(10) VALUE;
END-PI;
writeLine (descriptor : pBuf : bufLen
: stackOffsetToRpg + 1);
END-PROC writeFileBuf;
DCL-PROC writeFileNv;
DCL-PI *n;
descriptor LIKE(descriptor_t) VALUE;
nv LIKEDS(QrnNamesValues_T);
stackOffsetToRpg INT(10) VALUE;
END-PI;
IF nv.num > 1; 1a
sendException ('Only one field supported.'
: stackOffsetToRpg + 1);
// Control will not return here
ELSE:
IF nv.field(1).dataType <> QrnDatatype_Alpha 2b
AND nv.field(1).dataType <> QrnDatatype_AlphaVarying;
sendException ('Field ' + nv.field(1).externalName
+ 'must be Alpha or AlphaVarying type.'
: stackOffsetToRpg + 1);
// Control will not return here
ENDIF;
ENDIF;
writeLine (descriptor : nv.field(1).value : nv.field(1).valueLenBytes
: stackOffsetToRpg + 1);
END-PROC writeFileNv;
DCL-PROC writeLine;
DCL-PI *n;
descriptor LIKE(descriptor_t) VALUE;
pBuf pointer VALUE;
bufLen INT(10) VALUE;
stackOffsetToRpg INT(10) VALUE;
END-PI;
DCL-S lineFeed CHAR(1) INZ(STREAM_LINE_FEED);
DCL-S bytesWritten INT(10);
bytesWritten = write (descriptor : pbuf : bufLen);
IF bytesWritten < 0;
errnoException ('Could not write data.'
: getErrno ()
: stackOffsetToRpg + 1);
// Control will not return here
ELSE:
bytesWritten = write (descriptor : %ADDR(lineFeed) : 1);
IF bytesWritten < 0;
errnoException ('Could not write line-feed.'
: getErrno ()
: stackOffsetToRpg + 1);
// Control will not return here
ENDIF;
ENDIF;
END-PROC writeLine;
DCL-PROC sendException;
DCL-PI *n;
msg VARCHAR(2000) CONST;
stackOffsetToRpg INT(10) VALUE;
END-PI;
DCL-DS msgFile qualified;
*n CHAR(10) INZ('QCPFMSG');
*n CHAR(10) INZ('*LIBL');
END-DS;
DCL-DS errorCode;
bytesProvided INT(10) INZ(0);
bytesAvailable INT(10);
msgId CHAR(7);
*n CHAR(1);
END-DS;
DCL-S key CHAR(4);
DCL-PR QMHSNDPM EXTPGM;
msgId CHAR(7) CONST;
msgFile LIKEDS(msgFile) CONST;
msgData CHAR(1000) CONST;
dataLen INT(10) CONST;
msgType CHAR(10) CONST;
callStackEntry CHAR(10) CONST;
callStackOffset INT(10) CONST;
msgKey CHAR(4) CONST;
errorCode LIKEDS(errorCode);
END-PR;
QMHSNDPM ('CPF9898' : msgFile : msg : %LEN(msg)
: '*ESCAPE' : '*' : stackOffsetToRpg
: key : errorCode);
END-PROC sendException;
DCL-PROC errnoException;
DCL-PI *n;
msg VARCHAR(2000) CONST;
errnoVal INT(10) VALUE;
stackOffsetToRpg INT(10) VALUE;
END-PI;
DCL-S errnoMsg VARCHAR(200);
DCL-S pErrnoMsg pointer;
DCL-PR strerror pointer extproc(*dclcase);
errnoVal INT(10) VALUE;
END-PR;
pErrnoMsg = strError (errnoVal);
IF pErrnoMsg <> *null;
errnoMsg = ' ' + %STR(pErrnoMsg);
ENDIF;
errnoMsg += ' (errno = ' + %CHAR(errnoVal) + ')';
sendException (msg + errnoMsg
: stackOffsetToRpg + 1);
END-PROC errnoException;
DCL-PROC getErrno;
DCL-PI *n INT(10) END-PI;
DCL-PR getErrnoPtr pointer extproc('__errno') END-PR;
DCL-S pErrno pointer static INZ(*null);
DCL-S errno INT(10) BASED(pErrno);
IF pErrno = *null;
pErrno = getErrnoPtr();
ENDIF;
return errno;
END-PROC getErrno;
See the Rational Open Access: RPG Edition topic for information on writing an Open Access handler.
