These are the assorted source files for the Open Access for RPG example published in the July 2010 issue of the iSeries EXTRA newsletter. You can find the article here..
|
|
The "User" Program
This uses the OAR Handler program shown below. Note that the only difference in the code from a conventional write-disk-file is the use of the HANDLER keyword on the file's F-spec. The second parameter to the handler is used to supply the name of the IFS file to use.
H dftactgrp(*no) option(*NoDebugIO : *SrcStmt)
// IFS output file - file definition specifies fields to output
FIFS_OUT1 o e Disk Handler('HND_IFS_J2' : ifs_info1)
F UsrOpn
FTEST1 if e Disk
// Definition of the additional IFS data (path)
/copy ifs_cpy
D ifs_info1 ds likeds(ifs_hdlr_info_t)
/free
ifs_info1.path = '/Partner400/IFS_J2_1.csv';
open IFS_OUT1;
read TEST1;
dow not %eof(TEST1);
Write IFS_OUT1R;
// read next record
read TEST1;
enddo;
*inlr = *On;
The Handler Program
All of the real work takes place in this handler. In this example it has been compiled as a PGM object. The /COPY members used (other than the IBM supplied ones) can be found here.
// 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.
H DftActGrp(*No) Option(*SrcStmt)
// Standard IBM supplied Open Access definitions
/copy qrnopenacc
// Definition of additional handler parameter and constants
/copy ifs_cpy
// Standard IBM supplied IFS prototypes
/copy qsysinc/qrpglesrc,ifs
// RPG Status code values
/copy monstatcds
// On V7 and later systems this PR can be removed and so can those for
// local subprocedures openFile(), writeFile() and closeFile().
D HND_IFS_J2 Pr ExtPgm('HND_IFS_J2')
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 writeFile pr like(filehandle)
D handle like(fileHandle) value
D closeFile pr
D handle like(fileHandle) value
D HND_IFS_J2 PI
D info likeds(QrnOpenAccess_T)
// 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_WRITE;
// Set up access to Name/Value information
pNvInput = info.namesValues;
// Write error is unlikely but signal it if it occurs
If ( writeFile(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_CREAT + O_WRONLY + O_CCSID + O_TRUNC
+ O_TEXTDATA + O_TEXT_CREAT
: S_IRUSR + S_IWUSR + S_IRGRP + S_IROTH
: 819
: 0 );
/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 writeFile b
D pi like(filehandle)
D handle like(fileHandle) value
D buffer s 32740a Varying Inz
D value s 32470a Based(pvalue)
D i s 5i 0
D reply s 10i 0
D comma c ','
D quote c '"'
D CRLF c x'0d25'
/free
// Process all fields in record
For i = 1 to nvInput.num;
pvalue = nvInput.field(i).value; // set up to access data
If ( nvInput.field(i).dataType = QrnDatatype_Alpha )
Or ( nvInput.field(i).dataType = QrnDatatype_AlphaVarying);
buffer += quote
+ %trimR( %subst( value: 1: nvInput.field(i).valueLenBytes ))
+ quote;
ElseIf ( nvInput.field(i).dataType = QrnDatatype_Decimal );
buffer += %subst(value: 1: nvInput.field(i).valueLenBytes);
ElseIf ( nvInput.field(i).dataType = QrnDatatype_Date );
buffer += %subst(value: 1: nvInput.field(i).valueLenBytes);
EndIf;
If i <> nvInput.num; // Add comma after every field except the last
buffer += comma;
EndIf;
EndFor;
buffer += CRLF; // Add record termination
// reply will contain the length of data written or -1 in case of error
reply = write ( handle: %Addr(buffer:*Data): %Len(buffer) );
Return reply;
/end-free
P writeFile e
/COPY Files Used
These are the two /Copy members used. The first is used to describe the additional parameter passed to the handler, in this case to supply the IFS file name. The second is a standard one I use in many programs. It contains the status codes that I normally use with MONITOR. In this case they are used to signal a specific error condition back to the "User" program. The other /COPY members used are IBM supplied.
File IFS_CPY
// COPY file defining the additional HANDLER parameter used to allow
// the RPG program to pass the IFS path to the handler
// Also contains constants used in the I/O routines
/if defined(IFS_CPY_COPIED)
/eof
/endif
/define IFS_CPY_COPIED
D ifs_hdlr_info_t...
D ds qualified template
D path 5000a varying
D fileNotOpen c -1
D fileError c -1
File MONSTATCDS
// RPG IV Status codes for use with MONITOR or whatever ...
/if defined(MONSTATCDS_COPIED)
/eof
/endif
/define MONSTATCDS_COPIED
// 00000 No error.
D stsNoError C 00000
// 00001 Called program returned with *INLR on.
D stsPgmRetLR C 00001
// 00002 Function key pressed.
D stsFkeyPressed C 00002
// 00011 End of file (%EOF = *ON).
D stsEOF C 00011
// 00012 Record not found (%FOUND = *OFF).
D stsNotFnd C 00012
// 00013 Write to full subfile.
D stsWrtSflFull C 00013
// 00050 Conversion resulted in substitution.
D stsCvtSubst C 00050
// 00100 String operation, value out of range.
D errInvalString C 00100
// 00101 Negative square root.
D errNegSqrt C 00101
// 00102 Divide by zero.
D errDivZero C 00102
// 00103 Intermediate result too small to contain result.
D errResultTooSmall...
D C 00103
// 00104 Float underflow. Intermediate value too small.
D errFltUndflow C 00104
// 00105 Invalid characters in character to numeric conversion
D errInNumConv C 00105
// 00112 Invalid date, time, or timestamp value.
D errInvalDate C 00112
// 00113 Date overflow or underflow.
D errDateOvflow C 00113
// 00114 Date mapping error.
D errDateMap C 00114
// 00115 Invalid length for variable-length field.
D errInvalVarLen C 00115
// 00120 Table or array out of sequence.
D errArrSeq C 00120
// 00121 Invalid array index.
D errArrIdx C 00121
// 00122 OCCUR value out of range.
D errInvalOccur C 00122
// 00123 RESET attempted during initialization.
D errInzReset C 00123
// 00202 Call to program or procedure ended in error.
D errCallFail C 00202
// 00211 Error occurred while calling program or procedure.
D errCall C 00211
// 00221 Called program tried to use unpassed parameter.
D errParmNoPass C 00221
// 00222 Pointer or parameter error.
D errPtrParm C 00222
// 00231 Called program returned with halt indicator on.
D errCallHalt C 00231
// 00232 Halt indicator on in this program.
D errHalt C 00232
// 00233 Halt indicator on when RETURN operation run.
D errHaltRtn C 00233
// 00299 RPG dump failed.
D errDumpFail C 00299
// 00301 Error in method call.
D errMthCall C 00301
// 00302 Error converting Java array to RPG parm entering Java
// native meth
D errCvtJavArrEnt...
D C 00302
// 00303 Error converting RPG parm to Java array exiting RPG
// native method
D errCvtRpgPrmOut...
D C 00303
// 00304 Error converting RPG parm to Java array preparing
// Java meth call.
D errCvtRPGtoJavaArray...
D C 00304
// 00305 Error cvting Java array to RPG parm/return value
// after meth call.
D errCvtJavArrayToRPG...
D C 00305
// 00306 Error converting RPG return value to Java array.
D errcvtRpgRtnVal...
D C 00306
// 00333 Error on DSPLY operation.
D errDsply C 00333
// 00401 Data area not found.
D errDataAreaNotFnd...
D C 00401
// 00402 *PDA not valid for non-prestart job.
D errInvalPsjPDA C 00402
// 00411 Data area types/lengths do not match.
D errInvalDataArea...
D C 00411
// 00412 Data area not allocated for output.
D errDataAreaNoOutput...
D C 00412
// 00413 I/O error while processing data area.
D errDataAreaIO...
D C 00413
// 00414 Not authorized to use data area.
D errDataAreaUseAut...
D C 00414
// 00415 Not authorized to change data area.
D errDataAreaChgAut...
D C 00415
// 00421 Error while unlocking data area.
D errDataAreaUnlFail...
D C 00421
// 00425 Requested storage allocation length out of range.
D errInvalAlloc C 00425
// 00426 Error during storage management operation.
D errStorFail C 00426
// 00431 Data area previously allocated to another process.
D errDataAreaAlloc...
D C 00431
// 00432 *LOCK for data area not granted.
D errDataAreaLock...
D C 00432
// 00450 Character field not enclosed by SO and SI.
D errInvalSosi C 00450
// 00451 Cannot convert between two CCSIDs.
D errCvtCcsid C 00451
// 00501 Sort sequence not retrieved.
D errSortRtv C 00501
// 00502 Sort sequence not converted.
D errSortCvt C 00502
// 00802 Commitment control not active.
D errCmtNact C 00802
// 00803 Rollback failed.
D errRolbkFail C 00803
// 00804 COMMIT error.
D errCmt C 00804
// 00805 ROLBK error.
D errRolbk C 00805
// 00907 Decimal data error.
D errDecimal C 00907
// 00970 Compiler/runtime level check.
D errCompLevChk C 00970
// 01011 Undefined record type.
D errUndefRecTyp C 01011
// 01021 Record already exists.
D errRecExists C 01021
// 01022 Referential constraint error.
D errRefCst C 01022
// 01023 Trigger program error before operation.
D errTrgBefore C 01023
// 01024 Trigger program error after operation.
D errTrgAfter C 01024
// 01031 Match field sequence error.
D errMatchSeq C 01031
// 01041 Array/table load sequence error.
D errLoadArr C 01041
// 01042 Array/table load sequence error.
D errArrAltSeq C 01042
// 01051 Excess entries in array/table file.
D errArrOvflow C 01051
// 01071 Record out of sequence.
D errInvalRecSeq C 01071
// 01121 No Print Key DDS keyword indicator.
D errDDSPrtKey C 01121
// 01122 No Page Down Key DDS keyword indicator.
D errDDSPgDn C 01122
// 01123 No Page Up Key DDS keyword indicator.
D errDDSPgUp C 01123
// 01124 No Clear Key keyword indicator.
D errDDSClrKey C 01124
// 01125 No Help Key DDS keyword indicator.
D errDDSHlpKey C 01125
// 01126 No Home Key DDS keyword indicator.
D errDDSHomeKey C 01126
// 01201 Record mismatch detected on input.
D errInpMisMatch C 01201
// 01211 I/O operation to a closed file.
D errIOClosed C 01211
// 01215 OPEN issued to already open file.
D errAlreadyOpen C 01215
// 01216 Error on implicit OPEN/CLOSE.
D errImpOpenClose...
D C 01216
// 01217 Error on explicit OPEN/CLOSE.
D errExpOpenClose...
D C 01217
// 01218 Unable to allocate record.
D errRcdLocked C 01218
// 01221 Update/delete operation without a prior read.
D errUpdNoRead C 01221
// 01222 Referential constraint allocation error.
D errRefCstAlloc C 01222
// 01231 Error on SPECIAL file.
D errSpecial C 01231
// 01235 Error in PRTCTL space or skip entries.
D errPrtCtl C 01235
// 01241 Record number not found.
D errRecNbrNotFnd...
D C 01241
// 01251 Permanent I/O error.
D errPermIO C 01251
// 01255 Session or device error.
D errSessDev C 01255
// 01261 Attempt to exceed maximum number of devices.
D errMaxDev C 01261
// 01271 Attempt to acquire unavailable device.
D errDevUnavail C 01271
// 01281 Operation to unacquired device.
D errDevUnacq C 01281
// 01282 Job ending with controlled option.
D errJobEndCtl C 01282
// 01284 Unable to acquire second device.
D errAcqAddDev C 01284
// 01285 Attempt to acquire an allocated device.
D errDevAlloc C 01285
// 01286 Attempt to open shared file with SAVDS or SAVIND.
D errShrOpn C 01286
// 01287 Response indicators overlap SAVIND indicators.
D errRespInd C 01287
// 01299 I/O error detected.
D errIO C 01299
// 01331 Wait time exceeded for WORKSTN file.
D errWait C 01331
// 09998 Internal failure in RPG runtime
D errIntRPGFail C 09998
// 09999 Program exception in system routine.
D errPgmExc C 09999
Want more information?
Got a question or comment about the site?
Please feel free to Contact Us at any time.}