Skip to content

Instantly share code, notes, and snippets.

@greghelton

greghelton/DATAQTESTS.rpgle

Last active March 27, 2019 21:50
Show Gist options
  • Save greghelton/cbf925e7d1c89a36fa5a to your computer and use it in GitHub Desktop.
Save greghelton/cbf925e7d1c89a36fa5a to your computer and use it in GitHub Desktop.
Download ZIP
Using an AS400 data queue to function as one or more arrays.
Raw
DATAQTESTS.rpgle
ctl-opt Main(Main) option(*srcstmt:*nodebugio:*nounref);
// **************************************************************
// CRTDTAQ DTAQ(qtemp/DTAQ512) MAXLEN(526) SEQ(*KEYED) KEYLEN(14)
// crtpgm dataqtests module(dataqtests dataqueues)
// **************************************************************
dcl-proc Main;
dcl-pi *N;
end-pi;
dcl-pr arrayPut INT(10) extproc(*DCLCASE);
dcl-parm inArrayName VARCHAR(10) VALUE;
dcl-parm inIndex INT(10) VALUE; // if Zero then append
dcl-parm inData VARCHAR(512) VALUE;
end-pr;
dcl-pr arrayGet IND extproc(*DCLCASE);
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inIndex INT(10) VALUE;
dcl-parm outData VARCHAR(512);
end-pr;
dcl-pr arrayLookup INT(10) extproc(*DCLCASE);
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inSearchArg VARCHAR(512) VALUE;
end-pr;
dcl-s foundIndicator IND;
dcl-s myIndex INT(10);
dcl-s tmpIndex INT(10);
dcl-s myData VARCHAR(512);
////////////////////////////////////////////////////
// verify multiples and subsequent get
////////////////////////////////////////////////////
for tmpIndex = 1 to 1000;
myIndex = arrayPut('aArray' : tmpIndex : 'this is the '
+ %char(tmpIndex) + 'th one');
endFor;
foundIndicator = arrayGet('aArray' : myIndex : myData);
////////////////////////////////////////////////////
// verify over-write and subsequent get
////////////////////////////////////////////////////
myIndex = arrayPut('aArray' : 888 :
'This is the replacement');
foundIndicator = arrayGet('aArray' : 888 : myData);
////////////////////////////////////////////////////
// verify a random one
////////////////////////////////////////////////////
foundIndicator = arrayGet('aArray' : 111 : myData);
////////////////////////////////////////////////////
// verify not found for non-existing element
////////////////////////////////////////////////////
foundIndicator = arrayGet('aArray' : 1111 : myData);
////////////////////////////////////////////////////
// verify lookup (functionality pending completion & testing)
////////////////////////////////////////////////////
myIndex = arrayLookup('aArray' : 'this is the first one');
end-proc;
Raw
DATAQUEUES.rpgle
ctl-opt Nomain
option(*srcstmt:*nodebugio:*nounref);
// ****************************************************************
// crtpgm dataqtests module(dataqtests dataqueues)
// ****************************************************************
// data queue key is queue name plus the INT(10) index
// CRTDTAQ DTAQ(qtemp/DTAQ512) MAXLEN(526) SEQ(*KEYED) KEYLEN(14)
// CRTDTAQ DTAQ(qtemp/DTAQ512) MAXLEN(526)
// CRTDTAQ DTAQ(GAH285/DTAQ538#2) MAXLEN(526)
// ****************************************************************
dcl-s ARRAY_INDEX INT(10) TEMPLATE;
dcl-ds ErrorDS QUALIFIED;
dcl-subf bytesProvided INT(5);
dcl-subf bytesAvailable INT(5);
dcl-subf exceptionID CHAR(7);
dcl-subf reserved CHAR(1);
dcl-subf dataPointer Pointer;
end-ds;
dcl-s qName CHAR(10);
dcl-s qLib CHAR(10);
dcl-s qLength Packed(5:0);
dcl-s qData CHAR(526);
dcl-s qWaitTime Packed(5:0);
dcl-s qKeyOrder CHAR(2);
dcl-s qKeyLen Packed(3:0);
dcl-s qKey CHAR(14);
dcl-ds qKeyDS QUALIFIED;
dcl-subf name LIKE(qName);
dcl-subf index LIKE(ARRAY_INDEX);
end-ds;
dcl-s qRemoveMsg CHAR(10) inz('*NO');
dcl-s qErrorCodeDsSz Packed(5:0);
dcl-s qErrorCode Like(ErrorDS);
dcl-pr QRCVDTAQ extpgm('QRCVDTAQ');
dcl-parm qName LIKE(qName);
dcl-parm qLib CHAR(10);
dcl-parm qLength Packed(5:0);
dcl-parm qData CHAR(526);
dcl-parm qWaitTime Packed(5:0);
dcl-parm qKeyOrder CHAR(2);
dcl-parm qKeyLen Packed(3:0);
dcl-parm qKey LIKE(qKey);
dcl-parm qInfoLen Packed(3:0);
dcl-parm qInfo Pointer;
dcl-parm qRemoveMsg CHAR(10);
dcl-parm qErrorCodeDsSz Packed(5:0);
dcl-parm qErrorCode Pointer;
end-pr;
dcl-pr QSNDDTAQ extpgm('QSNDDTAQ');
dcl-parm qName CHAR(10);
dcl-parm qLib CHAR(10);
dcl-parm qLength Packed(5:0);
dcl-parm qData CHAR(526);
dcl-parm qKeyLen Packed(3:0);
dcl-parm qKey LIKE(qKey);
end-pr;
// function arrayPut adds the given value to the queue and returns the index
// of the location where the value was added
dcl-pr arrayPut LIKE(ARRAY_INDEX) extproc(*DCLCASE);
dcl-parm inArrayName VARCHAR(10) VALUE;
dcl-parm inIndex LIKE(ARRAY_INDEX) VALUE;
dcl-parm inData VARCHAR(512) VALUE;
end-pr;
dcl-pr arrayGet IND extproc(*DCLCASE);
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inIndex LIKE(ARRAY_INDEX) VALUE;
dcl-parm outData VARCHAR(512);
dcl-parm deleteIndic IND VALUE options(*nopass);
end-pr;
dcl-pr arrayLookup LIKE(ARRAY_INDEX) extproc(*DCLCASE);
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inSearchArg VARCHAR(512) VALUE;
end-pr;
//////////////////////////////////////////////////////////////
dcl-proc arrayPut EXPORT;
dcl-pi *N LIKE(ARRAY_INDEX);
dcl-parm inArrayName VARCHAR(10) VALUE;
dcl-parm inIndex LIKE(ARRAY_INDEX) VALUE; //Zero then append
dcl-parm inData VARCHAR(512) VALUE;
end-pi;
dcl-s unusedData VARCHAR(512);
if inIndex <= 0;
return -1;
endIf;
arrayGet(inArrayName : inIndex : unusedData : *ON);
qName = 'DTAQ512';
qLib = 'QTEMP';
qKeyDS.name = inArrayName;
qKeyDS.index = inIndex;
qKey = qKeyDS;
qKeyLen = 14;
qData = qKey + inData;
qLength = %size(qData);
QSndDtaQ(qName : qLib : qLength : qData : qKeyLen : qkey);
return inIndex;
end-proc;
//////////////////////////////////////////////////////////////
dcl-proc arrayGet EXPORT;
dcl-pi *N IND;
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inIndex LIKE(ARRAY_INDEX) VALUE;
dcl-parm outData VARCHAR(512);
dcl-parm deleteIndic IND VALUE options(*nopass);
end-pi;
dcl-ds qInfoDS QUALIFIED;
dcl-subf bytesReturned Packed(7:0);
dcl-subf bytesAvail Packed(7:0);
dcl-subf jobName CHAR(10);
dcl-subf userName CHAR(10);
dcl-subf jobNumber CHAR(06);
dcl-subf senderUserName CHAR(10);
end-ds;
dcl-s qInfoLen Packed(3:0) inz(%size(qInfoDS));
dcl-s qInfoPtr Pointer inz(%addr(qInfoDs));
dcl-ds myDataDS QUALIFIED;
dcl-subf qName CHAR(10);
dcl-subf index LIKE(ARRAY_INDEX);
dcl-subf data CHAR(512);
end-ds;
dcl-ds qErrorCodeDS LIKEDS(ErrorDS)
BASED(qErrorCodePtr);
dcl-s qErrorCodePtr Pointer;
qRemoveMsg = '*NO';
if %parms = 4;
if deleteIndic;
qRemoveMsg = '*YES';
endIf;
endIf;
qName = 'DTAQ512';
qLib = 'QTEMP';
qLength = 526;
qWaitTime = 0;
qKeyOrder = 'EQ';
qKeyLen = 14;
qKeyDS.name = inArrayName;
qKeyDS.index = inIndex;
qKey = qKeyDS;
qInfoLen = %size(qInfoDS);
qErrorCodeDsSz = %size(qErrorCodeDS);
clear qData;
QRcvDtaQ (qName : qLib :
qLength : qData :
qWaitTime : qKeyOrder :
qKeyLen : qKey :
qInfoLen : qInfoPtr :
qRemoveMsg :
qErrorCodeDsSz : qErrorCodePtr);
If qLength = 0;
return *OFF;
EndIf;
myDataDS = qData;
outData = myDataDS.data;
return *ON;
end-proc;
//
dcl-proc arrayLookup EXPORT;
dcl-pi *N LIKE(ARRAY_INDEX);
dcl-parm inArrayName CHAR(10) VALUE;
dcl-parm inSearchArg VARCHAR(512) VALUE;
end-pi;
return -1; // functionality pending completion & testing
end-proc;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment