H DftActGrp(*No) Option(*SrcStmt)   // Standard IBM supplied Open Access definitions /copy QOAR/QRPGLESRC,QRNOPENACC // Données spécifiques à ce Handler /copy AF4SRCT/EXEMPLEOAR,xml_cpy // Standard IBM supplied IFS prototypes /copy qsysinc/qrpglesrc,ifs // RPG Status code values /copy AF4SRCT/EXEMPLEOAR,status   D XML_HDLR pr ExtPgm('XML_HDLR') D info likeds(QrnOpenAccess_T)   // sous procédures IFS D openFile pr like(fileHandle) D path like(xml_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 XML_HDLR PI D info likeds(QrnOpenAccess_T)   D nvInput ds likeds(QrnNamesValues_T) D based(pNvInput)   D xml_info ds likeds(xml_hdlr_info_t) D based(pIfs_info)   D fileHandle s 10i 0 based(pfileHandle) D buffer s 32740a Varying Inz D r s 10i 0 D CRLF c x'0d25'   /free pfileHandle = info.stateInfo;   pIfs_info = info.userArea;   |
If info.rpgOperation = QrnOperation_WRITE; pNvInput = info.namesValues;   If ( writeFile(fileHandle) = fileError ); info.rpgStatus = errIO; EndIf;   elseIf info.rpgOperation = QrnOperation_OPEN; info.useNamesValues = *On;   pfileHandle = %Alloc(%Size(fileHandle)); info.stateInfo = pfileHandle;   clear fileHandle;   fileHandle = openFile (xml_info.path); // Open file if fileHandle = fileNotOpen; info.rpgStatus = errImpOpenClose; // Open failed EndIf;   eval buffer = '<?xml version="1.0" encoding="ISO-8859-1"?>' + CRLF + '<' + %trim(xml_info.racine) + '>' + CRLF ; r = write ( fileHandle: %Addr(buffer:*Data): %Len(buffer) );   elseif info.rpgOperation = QrnOperation_CLOSE; buffer = '</' + %trim(xml_info.racine) + '>' +CRLF ; r = write ( fileHandle: %Addr(buffer:*Data): %Len(buffer) ); closeFile (fileHandle);   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(xml_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 '"'   /free buffer = '<' + %trim(xml_info.ligne) + '>' + CRLF; r = write ( handle: %Addr(buffer:*Data): %Len(buffer) ); clear buffer;   |
For i = 1 to nvInput.num; pvalue = nvInput.field(i).value; // set up to access data   buffer += ' <' + %trim( nvInput.field(i).externalName) + '>' ; buffer += %trimR( %subst( value: 1: nvInput.field(i).valueLenBytes )); buffer += '</' + %trim( nvInput.field(i).externalName) + '>' + CRLF ;   EndFor;   reply = write ( handle: %Addr(buffer:*Data): %Len(buffer) );   buffer = '</' + %trim(xml_info.ligne) + '>' + CRLF ; r = write ( handle: %Addr(buffer:*Data): %Len(buffer) );   Return reply;   /end-free P writeFile e |