Tweet
Re: Retrieve Command Defaults ?
I ran the following to list all commands via the API to an outfile for parsing as follows ...
If anyone can see why the API in this example returns blank then pls advise what I can do to fix it ...
First:
I created the outfile, I wanted a key on it so I could chain for updates later.
Then I made an RPG based on those from the links above that would use format DEST0100 and write to the outfile. I added purge and update options. I wanted to be able to do the following:
1 - Purge all records in the outfile for a given target library
2 - Add a record if the command does not already exist, else update it if it does exist.
Then I banged a CL on the front to grab all commands from a library, with the purge up front.
I ran the following to list all commands via the API to an outfile for parsing as follows ...
If anyone can see why the API in this example returns blank then pls advise what I can do to fix it ...
First:
I created the outfile, I wanted a key on it so I could chain for updates later.
PHP Code:
A*
A R XMLDMPR
A*
A XDLBNM 10A COLHDG('Command Lib')
A XDCDNM 10A COLHDG('Command Name')
A XDCDFN 10240A COLHDG('Command Definition')
A*
A K XDLBNM
A K XDCDNM
A*
1 - Purge all records in the outfile for a given target library
2 - Add a record if the command does not already exist, else update it if it does exist.
PHP Code:
** -- Output File declaration : --------------------------------------- **
Fxmldump UF A E K DISK
F*
** -- API Error Data Structure: --------------------------------------- **
D ApiError Ds
D AeBytPro 10i 0 Inz(%Size(ApiError))
D AeBytAvl 10i 0
D 1a
D AeExcpId 7a
D AeExcpDta 126a
D*
** -- Global variables: ----------------------------------------------- **
D OutStrLenRt s 10i 0
D NotSup s 10i 0
D FB s 10i 0 Dim( 3 )
D QualName s 20a Inz(*Blanks)
D*
** -- Input parameters: ----------------------------------------------- **
D p@CmdLib s 10a
D p@CmdName s 10a
D p@PrgData s 1a
D p@OutType s 10a
D*
** -- Command return variable: ---------------------------------------- **
D CdCmdd0100 Ds
D CdBytRtn 10i 0
D CdBytAvl 10i 0
D CdCmdXml 10240a
D*
** -- Retrieve Command Text: ------------------------------------------ **
D RtvCmdTxt Pr ExtPgm( 'QCDRCMDD' )
D RcCmdNamQ 20a Const
D RcDst 10i 0 Const
D RcDstFmt 8a Const
D RcRcvVar 32767a Options( *VarSize )
D RcRcvFmt 8a Const
D RcError 32767a Options( *VarSize )
D*
** -- Convert String: -------------------------------------------------- **
D CvtString Pr ExtPgm( 'QTQCVRT' )
D CsInpCcsId 10i 0 Const
D CsInpStrTyp 10i 0 Const
D CsInpStr 32767a Const Options( *VarSize )
D CsInpStrSiz 10i 0 Const
D CsOutCcsId 10i 0 Const
D CsOutStrTyp 10i 0 Const
D CsOutCvtAlt 10i 0 Const
D CsOutStrSiz 10i 0 Const
D CsOutStr 32767a Options( *VarSize )
D CsOutStrLenRt 10i 0
D CsNotSup 10i 0
D CsFB 10i 0 Dim( 3 )
**
** -- Mainline: ------------------------------------------------------- **
**
C *Entry Plist
C parm p@CmdLib
C parm p@CmdName
C parm p@PrgData
C parm p@OutType
**
** -- Mainline: ------------------------------------------------------- **
**
/free
// If Flag is set then purge data for that library first ...
If p@PrgData = 'Y';
ExSr PurgeLibraryData;
Else;
// Retrieve the Command Definition using the API ...
ExSr RetrieveCommandAPI;
// Convert The result to a readable format ...
ExSr ConvertString;
// Write the Dump data to the Outfile ...
If p@OutType = '*DMPFILE';
ExSr WriteDumpOut;
EndIf;
EndIf;
*INLR = *On;
Return;
// ==============================================
BegSr PurgeLibraryData;
SetLL *Start xmldump;
Chain (p@CmdLib) xmldump;
If %Found(xmldump);
DoW Not %EOF(xmldump);
Delete XmlDmpR;
ReadE (p@CmdLib) xmldump;
EndDo;
EndIf;
EndSr;
// ==============================================
BegSr WriteDumpOut;
xdlbnm = p@CmdLib;
xdcdnm = p@CmdName;
xdcdfn = CdCmdXml;
Chain (p@CmdLib:p@CmdName) xmldump;
If %Found(xmldump);
Update XmlDmpR;
Else;
Write XmlDmpR;
EndIf;
EndSr;
// ==============================================
BegSr RetrieveCommandAPI;
QualName = *Blanks;
%Subst(QualName:1:10) = %Trim(p@CmdName);
%Subst(QualName:11:10) = %Trim(p@CmdLib);
RtvCmdTxt( QualName
: %Size( CdCmdd0100 )
: 'DEST0100'
: CdCmdd0100
: 'CMDD0100'
: ApiError
);
EndSr;
// ==============================================
BegSr ConvertString;
CvtString( 1208
: 0
: CdCmdXml
: CdBytRtn
: 37
: 0
: 0
: CdBytRtn
: CdCmdXml
: OutStrLenRt
: NotSup
: FB
);
EndSr;
// ==============================================
/end-free
PHP Code:
/* +---------------------------------------------------------------------------+ */
/* | Lists all commands in the target library, then for each one calls the | */
/* | RPG program RTVCMDR1 to get the command source and output it to the file | */
/* +---------------------------------------------------------------------------+ */
PGM PARM(&LibName)
DCL VAR(&LibName) TYPE(*CHAR) LEN(10)
DCL VAR(&Purge) TYPE(*CHAR) LEN(1) VALUE(Y)
DCL VAR(&OutPut) TYPE(*CHAR) LEN(10) VALUE(*DMPFILE)
DCL VAR(&XXX) TYPE(*CHAR) LEN(10) VALUE(XXXXXXXXXX)
DCL VAR(&AddLib) TYPE(*CHAR) LEN(1) VALUE(Y)
DCL VAR(&JobTyp) TYPE(*CHAR) LEN(1)
DCLF FILE(QTEMP/CMDLIST)
ADDLIBLE LIB(TEMPFILES)
MONMSG MSGID(CPF2103) EXEC(CHGVAR VAR(&ADDLIB) VALUE(N))
RTVJOBA TYPE(&JOBTYP)
IF COND(&JOBTYP = '1') THEN(DO)
SBMJOB CMD(CALL PGM(RTVCMDC1) PARM(&LIBNAME)) +
JOB(RTVCMDSRC) JOBQ(MULTI)
GOTO CMDLBL(EOF)
ENDDO
DSPOBJD OBJ(&LibName/*ALL) OBJTYPE(*CMD) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/CMDLIST)
CALL PGM(RTVCMDR1) PARM(&XXX &XXX &Purge &XXX)
CHGVAR VAR(&Purge) VALUE(N)
READFILE: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
CALL PGM(RTVCMDR1) PARM(&ODLBNM &ODOBNM &Purge &OutPut)
GOTO CMDLBL(READFILE)
EOF:
IF COND(&ADDLIB = 'Y') THEN(RMVLIBLE LIB(TEMPFILES))
END: ENDPGM
Comment