Source Code for IBM Extra Article Open Access Part 2


		Source for Open Access Part 2 Example Code
		Here you can find the source files for the Currency Rates file (CURRATES) that is used in the example. The main source file for the handler (CURCONVHND), the test program from the article (CURHNDTST) and the extended test version that was mentioned (CURHNDTST2). We have also included the source for the RPG status codes that is /COPY'd into the handler (MONSTATCDS). The /COPY file QRNOPENACC is shipped by IBM as part of the Open Access support. The file HTTPAPI_H is part of Scott's HTTPAPI download which you can find at his web site www.ScottKlement.com.
[an error occurred while processing this directive]		DDS for Currency Rates "File" A R CURRRATESR A FROMCNTRY 3A A TOCNTRY 3A A RATE 15P 5 A K FROMCNTRY A K TOCNTRY Handler Program CURCONVHND // An RPG Open Access handler that supports CHAINing to a web service. // - All of the web service processing is done with Scott Klement's // HTTPAPI. This code is actually based on Example 16. H DFTACTGRP(NO) BNDDIR('HTTPAPI') // Set up Rates file as template to facilitate LikeRec definitions (A) FCurrRates IF E K DISK Template D CurrRateHndlr Pr ExtPgm('CURCONVHND') D info LikeDS(QrnOpenAccess_T) D CurrRateHndlr PI (B) D info LikeDS(QrnOpenAccess_T) // Prototypes etc. for HTTPAPI /copy libhttp/qrpglesrc,httpapi_h // Standard RPG status codes /copy MonStatCds // Standard IBM supplied Open Access definitions (C) /copy qrnopenacc // DS to map record layout to return data (D) D CurrRatesD DS LikeRec(CurrRatesR: Input) D Based(info.inputBuffer) // DS to map supplied keys (D) D CurrRatesK DS LikeRec(CurrRatesR: Key) D Based(info.key) // The prototypes for DoChain and ProcessElement can be omitted if you // are compiling for V7 and later. For V6 they must be present. D DoChain PR // This is the prototype for the call back process used by HTTPAPI to // process the individual elements extracted from the SOAP response. D ProcessElement PR D rate 20a D depth 10I 0 value D name 1024A varying const D path 24576A varying const D value 65535A varying const D attrs dim(32767) D const options(varsize) D NOT_FOUND c 'NF' D SOAP s 32767A varying D rc s 10I 0 D charRate s 20a D inUse s n Inz(Off) /free (E) If info.rpgOperation = QrnOperation_CHAIN; DoChain(); // Open needs to check if another program in the job is already using // it. If so it issues an error - concurrent useage is not supported. (F) ElseIf (info.rpgOperation = QrnOperation_OPEN); If not inUse; inUse = On; http_debug(On); Else; // Issue message and set I/O error status. info.rpgStatus = errIO; dsply ('Handler in use and cannot support concurrent opens'); EndIf; (G) ElseIf (info.rpgOperation = QrnOperation_CLOSE); http_debug(Off); inUse = Off; InLR = On; Else; // Any other operation is unsupported so notify RPG (H) dsply ('Unsupported op-code. Requested code was ' + %Char(info.rpgOperation)); info.rpgStatus = errIO; // Set general I/O error status Endif; Return; /End-free (I) p DoChain B d pi // This sample calls the Currency Exchange Rate Web service // provided by WebserviceX.net. For more info, search for it // at http://www.WebserviceX.net /Free http_XmlStripCRLF(On); SOAP = '' +'' +'' +' ' +' ' + %trim(currRatesK.FROMCNTRY) +'' +' '+ %trim(currRatesK.TOCNTRY) + '' +' ' +'' +''; // Set rate field to not found status - that way if the web service can't // find a rate, or if any error occurred we would signal not found. (J) charRate = NOT_FOUND; rc = http_url_post_xml( 'http://www.webservicex.net/CurrencyConvertor.asmx' : %addr(SOAP) + 2 : %len(SOAP) : NULL : %paddr(processElement) : %addr(charRate) : HTTP_TIMEOUT : HTTP_USERAGENT : 'text/xml' : 'http://www.webserviceX.NET/ConversionRate'); (K) If (charRate <> NOT_FOUND) ; currRatesD.rate = %dech(charRate: 15: 5); // Copy key data to input buffer currRatesD.FROMCNTRY = currRatesK.FROMCNTRY; currRatesD.TOCNTRY = currRatesK.TOCNTRY; info.found = On; else; info.found = Off; endif; Return; /end-free p doChain E P ProcessElement B D PI D rate 20a D depth 10I 0 value D name 1024A varying const D path 24576A varying const D value 65535A varying const D attrs * dim(32767) D const options(varsize) /free if (name = 'ConversionRateResult'); // Actual value received rate = value; endIf; /end-free P E Program CURHNDTST - Original Test Program from the Extra Article. // Tests an RPG Open Access SOAP web service handler H DFTACTGRP(NO) FCurrRates IF E K DISK Handler('CURCONVHND') D from s Like(fromCntry) D to s Like(toCntry) /free from = 'USD'; to = 'CAD'; Chain (from: to) CurrRates; If %Found(CurrRates); Dsply ('Conversion rate from ' + fromCntry + ' to ' + toCntry + ' is ' + %Char(rate)); Else; Dsply ('No record found for ' + from + ' to ' + to ); EndIf; InLr = On; Return; /End-free Program CURHNDTST2 - Enhanced version of the test program // Tests an RPG Open Access SOAP web service handler H DFTACTGRP(NO) FCurrRates IF E K DISK Handler('CURCONVHND') D forever s n Inz(Off) /free Dou ( forever ); Dsply ('Enter "From" currency: ') ' ' FROMCNTRY; If ( FROMCNTRY = 'end' ); Leave; EndIf; Dsply ('Enter "To" currency: ') ' ' TOCNTRY; Chain (FROMCNTRY: TOCNTRY) CurrRates; If %Found(CurrRates); Dsply ('Conversion rate from ' + FROMCNTRY + ' to ' + TOCNTRY + ' is ' + %Char(RATE)); Else; Dsply ('No record found for ' + FROMCNTRY + ' to ' + TOCNTRY ); EndIf; EndDo; InLr = On; Return; /End-free /COPY File MONSTATCDS This file is handy when using the MONITOR op-code as it contains named constants for all the RPG status codes. In this OA handler however we use it to supply the numeric codes to set the RPG error status. // 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 compiler or in runtime // subroutines. D errIntRPGFail C 09998 // 09999 Program exception in system routine. D errPgmExc C 09999

Return to Home Page		Want more information? Got a question or comment about the site? Please feel free to Contact Us at any time.}