Category: News

What is PCML?

Program Call Markup Language (PCML) is a tag language based on the Extensible Markup Language (XML) that describes the input and output parameters of a program or the exported procedures of a module that is part of a service program.

Although PCML was designed to support distributed program calls to server program objects from a client Java platform, you can also use PCML to make calls to a server program from within the server environment.

Who uses it?

The IBM Toolbox for Java includes an application programming interface (API) that interprets the PCML, calls the program, and simplifies the retrieval of data returned from the IBM i system.

A huge benefit of PCML is that it allows you to write less code. Ordinarily, extra code is needed to connect, retrieve, and translate data between a server and IBM Toolbox for Java objects. However, by using PCML, your calls to the server with the IBM Toolbox for Java classes are automatically handled. PCML class objects are generated from the PCML tags and help minimize the amount of code you need to write in order to call server programs from your application.

The IBM i Integrated Web Services (IWS) can use the PCML embedded in a program or service program to generate a web service from your program or a procedure in your service program.

How is it created?

The ILE COBOL and ILE RPG compilers, during the module creation phase, can generate the PCML in a stream file, using the parameters PGMINFO(*PCML *STMF) and INFOSTMF(‘mymodule.pcml‘), or in the module itself (and consequently in the program that will include it), using PGMINFO(*PCML *MODULE), or in both, specifying the parameters PGMINFO(*PCML *ALL) and INFOSTMF(‘mymodule.pcml‘).

Note: The same compiler directives can be included in the source code (in Cobol, the PROCESS statement is used to indicate the compilation options to be used, so, for example: PROCESS PGMINFO(PCML MODULE), while in RPG the operating code Ctl-Opt is used, so, for example: Ctl-Opt PgmInfo(*PCML: *MODULE)).

Obviously, when PCML is embedded in a module, it becomes part of the program or service program in which the module is included.

If your ILE RPG or ILE COBOL modules embed PCML then you can extract it or even just verify its existence. This can be done using the QBNRPII (Retrieve Program Interface Information) API.

CPYPCMLSTM

The CPYPCMLSTM program is an ILE CL language implementation of the QBNRPII API. Program interface information in PCML format is extracted from modules included in a program or service program compiled with PGMINFO(*PCML *MODULE) or PGMINFO(*PCML *ALL) parameters and copied into user space (so that it can dynamically allocate the memory required to store that information) then converted into the usual format for greater readability (the PCML extracted from the API is a string of characters without formatting) and finally written to a stream file on IFS using the IBM i SQL service IFS_WRITE.

Here’s what the command looks like:

Copy PCML from module to STMF (CPYPCMLSTM)

Immettere le scelte e premere Invio.

Object (containing module) . . . Nome
Library . . . . . . . . . . . *LIBL Nome, *CURLIB, *LIBL
Object type . . . . . . . . . . *PGM *PGM, *SRVPGM
Module . . . . . . . . . . . . . *ALLBNDMOD Nome, *ALLBNDMOD
Library . . . . . . . . . . . Nome, *ANY
Target directory . . . . . . . .

STMF CCSID . . . . . . . . . . . *UTF8 1-65533, *UTF8, *PCASCII…
STMF EOL . . . . . . . . . . . . *CRLF *CRLF, *LF, *CR, *LFCR

Below is a brief description of the parameters (the same as in the QBNRPII API, except for the TODIR, STMFCCSID, STMFEOL parameters that are used by the IFS_WRITE SQL service to write the stream file):

OBJ: specifies the program or service program that includes the modules containing the PCMLs to be extracted;
OBJTYPE: specifies the type of object from which to extract the information the interface information (*PGM, the default value, or *SRVPGM);
MODULE: specifies the module from which to extract the PCML (the default value is *ALLBNDMOD);
TODIR: specifies the IFS path where to write the PCML(s) (the stream file(s) containing the PCML(s) will be called objectname_modulename.pcml);
STMFCCSID: specifies the CCSID used in the creation of the output stream file(s) (default value is *UTF8);
STMFEOL: specifies the sequence of end-of-line characters to be written to the output stream file (default value is *CRLF).

So, for example, if you want to retrieve all the modules contained in the PGMX program and write them to the /DIRZ directory using the UTF-8 character encoding with a carriage return and a line feed (CRLF) as line termination sequence (default value), you would enter the following command:

CPYPCMLSTM OBJ(PGMX) OBJTYPE(*PGM) MODULE(*ALLBNDMOD) TODIR(‘/DIRZ’) STMFCCSID(*UTF8) STMFEOL(*CRLF)

Running this command will generate as many PCML output files as modules with PCML embedded included in the program.

If, on the other hand, you wanted to extract into the /DIRZ path the PCML extracted from the LIBY/MODY module bound to the PGMX service program using CCSID 819 and line feed as the line termination sequence, you would type:

CPYPCMLSTM OBJ(PGMX) OBJTYPE(*SRVPGM) MODULE(LIBY/MODY) TODIR(‘/DIRZ’) STMFCCSID(*UNIX) STMFEOL(*LF)

Below is an example of the output of the command and an example of an output file containing a PCML extracted with the CPYPCMLSTM command:

Program Call Markup Language (PCML) found: 2.
Program Call Markup Language (PCML) data for MOD(QTEMP/MODX) in
PGM(QGPL/TESTPGM) copied to file
‘/DIRZ/TESTPGM_MODX.pcml’.
Program Call Markup Language (PCML) data for MOD(QTEMP/MODY) in
PGM(QGPL/TESTPGM) copied to file
‘/DIRZ/TESTPGM_MODY.pcml’.
Program Call Markup Language (PCML) retrieved: 2.

<pcml version=”4.0″>
<program name=”MODY” entrypoint=”MODY”>
<struct name=”RMODY-PARM” usage=”inputoutput”>
<struct name=”RMODY-INPUT” usage=”inherit”>
<data name=”RMODY-CD-DFE” type=”zoned” length=”8″ precision=”0″ usage=”inherit” />
<data name=”RMODY-CD-VERSIONE-DFE” type=”zoned” length=”2″ precision=”0″ usage=”inherit” />
<data name=”RMODY-FL-BENEFICIARI” type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-RAGSOC-BEN1″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-NOME-BEN1″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-CF-PIVA-BEN1″ type=”char” length=”16″ usage=”inherit” />
<data name=”RMODY-INDIR-BEN1″ type=”char” length=”40″ usage=”inherit” />
<data name=”RMODY-LOCAL-BEN1″ type=”char” length=”30″ usage=”inherit” />
<data name=”RMODY-CAP-BEN1″ type=”char” length=”5″ usage=”inherit” />
<data name=”RMODY-PROV-BEN1″ type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-TEL-BEN1″ type=”char” length=”13″ usage=”inherit” />
<data name=”RMODY-EMAIL-BEN1″ type=”char” length=”80″ usage=”inherit” />
<data name=”RMODY-RELAZIONE-BEN1″ type=”char” length=”30″ usage=”inherit” />
<data name=”RMODY-FLINVIO-BEN1″ type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-RAGSOC-BEN2″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-NOME-BEN2″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-CF-PIVA-BEN2″ type=”char” length=”16″ usage=”inherit” />
<data name=”RMODY-INDIR-BEN2″ type=”char” length=”40″ usage=”inherit” />
<data name=”RMODY-LOCAL-BEN2″ type=”char” length=”30″ usage=”inherit” />
<data name=”RMODY-CAP-BEN2″ type=”char” length=”5″ usage=”inherit” />
<data name=”RMODY-PROV-BEN2″ type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-TEL-BEN2″ type=”char” length=”13″ usage=”inherit” />
<data name=”RMODY-EMAIL-BEN2″ type=”char” length=”80″ usage=”inherit” />
<data name=”RMODY-RELAZIONE-BEN2″ type=”char” length=”30″ usage=”inherit” />
<data name=”RMODY-FLINVIO-BEN2″ type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-RAGSOC-REF3″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-NOME-REF3″ type=”char” length=”55″ usage=”inherit” />
<data name=”RMODY-CF-PIVA-REF3″ type=”char” length=”16″ usage=”inherit” />
<data name=”RMODY-INDIR-REF3″ type=”char” length=”40″ usage=”inherit” />
<data name=”RMODY-LOCAL-REF3″ type=”char” length=”30″ usage=”inherit” />
<data name=”RMODY-CAP-REF3″ type=”char” length=”5″ usage=”inherit” />
<data name=”RMODY-PROV-REF3″ type=”char” length=”2″ usage=”inherit” />
<data name=”RMODY-TEL-REF3″ type=”char” length=”13″ usage=”inherit” />
<data name=”RMODY-EMAIL-REF3″ type=”char” length=”80″ usage=”inherit” />
</struct>
</struct>
<struct name=”RMODY-RC” usage=”inputoutput”>
<data name=”RMODY-RETCOD” type=”char” length=”7″ usage=”inherit” />
</struct>
</program>
</pcml>

Below are the sources of the command and the CLLE program:

CMD PROMPT(‘Copy PCML from module to STMF’)
PARM KWD(OBJ) TYPE(QOBJ) MIN(1) PROMPT(‘Object +
(containing module)’ 1)
PARM KWD(TODIR) TYPE(*PNAME) LEN(128) MIN(1) EXPR(*YES) +
PROMPT(‘Target directory’ 4)
PARM KWD(OBJTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*PGM) SPCVAL((*PGM) (*SRVPGM)) EXPR(*YES) +
PROMPT(‘Object type’ 2)
PARM KWD(MODULE) TYPE(QMOD) DFT(*ALLBNDMOD) +
SNGVAL((*ALLBNDMOD)) PROMPT(‘Module’ 3)
PARM KWD(STMFCCSID) TYPE(*INT4) DFT(*UTF8) RANGE(1 +
65533) SPCVAL((*UTF8 1208) (*PCASCII 1252) +
(*STDASCII 850) (*UNIX 819)) EXPR(*YES) +
PROMPT(‘STMF CCSID’ 5)
PARM KWD(STMFEOL) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*CRLF) SPCVAL((*CRLF) (*LF) (*CR) (*LFCR)) +
EXPR(*YES) PROMPT(‘STMF EOL’ 6)
QOBJ: QUAL TYPE(*NAME) EXPR(*YES) LEN(10)
QUAL TYPE(*NAME) EXPR(*YES) LEN(10) DFT(*LIBL) +
SPCVAL((*CURLIB) (*LIBL)) PROMPT(‘Library’)
QMOD: QUAL TYPE(*NAME) EXPR(*YES) LEN(10)
QUAL TYPE(*NAME) EXPR(*YES) LEN(10) DFT(*ANY) +
SPCVAL((*ANY)) PROMPT(‘Library’)

PGM PARM(&PQOBJ &PTODIR &POBJTYPE &PQMOD &PSTMFCCSID +
&PSTMFEOL)

/* Parameters */
DCL VAR(&PQOBJ) TYPE(*CHAR) LEN(20)
DCL VAR(&POBJ) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PQOBJ 1)
DCL VAR(&POBJLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PQOBJ 11)
DCL VAR(&PTODIR) TYPE(*CHAR) LEN(128)
DCL VAR(&POBJTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&PQMOD) TYPE(*CHAR) LEN(20)
DCL VAR(&PMOD) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PQMOD 1)
DCL VAR(&PMODLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PQMOD 11)
DCL VAR(&PSTMFCCSID) TYPE(*INT) LEN(4)
DCL VAR(&PSTMFEOL) TYPE(*CHAR) LEN(5)

/* stat64 */
DCL VAR(&STATRTNVAL) TYPE(*INT) LEN(4)
DCL VAR(&STATPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&STATBUFFER) TYPE(*CHAR) LEN(4096)
DCL VAR(&STATOBJTYP) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&STATBUFFER 61)
/* DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X’00’) */

/* strlen */
DCL VAR(&STRTMP) TYPE(*CHAR) LEN(32767)
DCL VAR(&LENINT) TYPE(*UINT) LEN(4)
/* DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X’00’) */

/* SUBR(RTVPGMINF): Start ********************************************/
DCL VAR(&RTVPGMINF) TYPE(*INT) LEN(4)

/* QCLRPGMI (Retrieve Program Information) */
DCL VAR(&PGMI0100V) TYPE(*CHAR) LEN(536)
DCL VAR(&PGMTYPE) TYPE(*CHAR) STG(*DEFINED) LEN(1) +
DEFVAR(&PGMI0100V 161) /* ‘ ‘=OPM, ‘B’=ILE */
DCL VAR(&PGMI0100L) TYPE(*INT) LEN(4) VALUE(536)
DCL VAR(&PGMI0100QO) TYPE(*CHAR) LEN(20)
/* SUBR(RTVPGMINF): End **********************************************/

/* SUBR(RTVSRVPGMI): Start *******************************************/
DCL VAR(&RTVSRVPGMI) TYPE(*INT) LEN(4)

/* QBNRSPGM (Retrieve Service Program Information) */
DCL VAR(&SPGI0100V) TYPE(*CHAR) LEN(5444)
DCL VAR(&SPGI0100L) TYPE(*INT) LEN(4) VALUE(5444)
DCL VAR(&SPGI0100QO) TYPE(*CHAR) LEN(20)
/* SUBR(RTVSRVPGMI): End *********************************************/

/* SUBR(RTVPCML): Start **********************************************/
DCL VAR(&RTVPCML) TYPE(*INT) LEN(4)

/* DLTUSRSPC, QUSCRTUS, QUSPTRUS, QUSCUSAT */
DCL VAR(&QUSRSPC) TYPE(*CHAR) LEN(20)
DCL VAR(&USRSPC) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&QUSRSPC 1)
DCL VAR(&USRSPCLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&QUSRSPC 11)
DCL VAR(&USEXTATR) TYPE(*CHAR) LEN(10)
DCL VAR(&USINITSIZ) TYPE(*INT) LEN(4)
DCL VAR(&USINITVAL) TYPE(*CHAR) LEN(1)
DCL VAR(&USPUBAUT) TYPE(*CHAR) LEN(10)
DCL VAR(&USTEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&USREPLACE) TYPE(*CHAR) LEN(10)
DCL VAR(&USRTNLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&USCHGATR) TYPE(*CHAR) LEN(25)
DCL VAR(&USATRREC) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 1)
DCL VAR(&USATRKEY1) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 5)
DCL VAR(&USATRLEN1) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 9)
DCL VAR(&USATRDTA1) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 13)
DCL VAR(&USATRKEY2) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 17)
DCL VAR(&USATRLEN2) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&USCHGATR 21)
DCL VAR(&USATRDTA2) TYPE(*CHAR) STG(*DEFINED) LEN(1) +
DEFVAR(&USCHGATR 25)

/* QBNRPII */
DCL VAR(&RPII0100V) TYPE(*CHAR) LEN(32767)
DCL VAR(&RPII0100L) TYPE(*INT) LEN(4)
DCL VAR(&RPII0100QO) TYPE(*CHAR) LEN(20)
DCL VAR(&RPII0100OT) TYPE(*CHAR) LEN(10)
DCL VAR(&RPII0100QM) TYPE(*CHAR) LEN(20)

DCL VAR(&USPTR) TYPE(*PTR) /* Pointer to user space */
DCL VAR(&USDTA) TYPE(*CHAR) STG(*BASED) LEN(32767) +
BASPTR(&USPTR)

DCL VAR(&HDPTR) TYPE(*PTR) /* Pointer to generic +
header information */
DCL VAR(&HDDTA) TYPE(*CHAR) STG(*BASED) LEN(48) +
BASPTR(&HDPTR) /* Generic header information */
DCL VAR(&HDBYTRTN) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&HDDTA 1) /* Bytes returned */
DCL VAR(&HDBYTAVL) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&HDDTA 5) /* Bytes availabled */
DCL VAR(&HDOBJNAM) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&HDDTA 9) /* Object name */
DCL VAR(&HDOBJLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&HDDTA 19) /* Object library */
DCL VAR(&HDFSTOFF) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&HDDTA 41) /* Offset to first interface +
entry */
DCL VAR(&HDNBRENT) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&HDDTA 45) /* Number of entries */

DCL VAR(&ENPTR) TYPE(*PTR) /* Pointer to list entry */
DCL VAR(&ENDTA) TYPE(*CHAR) STG(*BASED) LEN(44) +
BASPTR(&ENPTR) /* Offset to next interface entry */
DCL VAR(&ENOFFNXT) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 1) /* Offset to next interface entry */
DCL VAR(&ENMODNAM) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&ENDTA 5) /* Module name */
DCL VAR(&ENMODLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&ENDTA 15) /* Module library */
DCL VAR(&ENCCSID) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 25) /* CCSID of interface +
information */
DCL VAR(&ENTYP) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 29) /* Type of interface information */
DCL VAR(&ENOFFINF) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 33) /* Offset to interface +
information */
DCL VAR(&ENLENINF) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 37) /* Length of interface +
information returned */
DCL VAR(&ENLENAVL) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&ENDTA 41) /* Length of interface +
information available */

DCL VAR(&INPTR) TYPE(*PTR) /* Pointer to interface +
information */
DCL VAR(&INDTA) TYPE(*CHAR) STG(*BASED) LEN(32767) +
BASPTR(&INPTR) /* Interface information */

DCL VAR(&ENT_OFF) TYPE(*INT) LEN(4)
DCL VAR(&I) TYPE(*UINT) LEN(4)

DCL VAR(&PCMLROW) TYPE(*CHAR) LEN(1024)
DCL VAR(&PCMLROWLEN) TYPE(*INT) LEN(4)
DCL VAR(&PCMLROWLVL) TYPE(*INT) LEN(4)
DCL VAR(&PCMLLEN) TYPE(*INT) LEN(4)
DCL VAR(&PCMLDIR) TYPE(*CHAR) LEN(256)
DCL VAR(&PCMLSTMF) TYPE(*CHAR) LEN(256)

DCL VAR(&MODULE) TYPE(*CHAR) LEN(21)
/* SUBR(RTVPCML): End ************************************************/

/* RUNSQL */
DCL VAR(&SQL) TYPE(*CHAR) LEN(5000)

/* API Error */
DCL VAR(&APIERROR) TYPE(*CHAR) LEN(1040)
DCL VAR(&AEBYTPRO) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&APIERROR 1)
DCL VAR(&AEBYTAVL) TYPE(*INT) STG(*DEFINED) LEN(4) +
DEFVAR(&APIERROR 5)
DCL VAR(&AEEXCPID) TYPE(*CHAR) STG(*DEFINED) LEN(7) +
DEFVAR(&APIERROR 9)
DCL VAR(&AEEXCPDTA) TYPE(*CHAR) STG(*DEFINED) +
LEN(1024) DEFVAR(&APIERROR 17)

/* _MATPGMNM */
DCL VAR(&DATA) TYPE(*CHAR) LEN(80)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PGMLIB) TYPE(*CHAR) LEN(10)

/* RTVJOBA */
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)

/* RCVMSG & SNDPGMMSG */
DCL VAR(&PRCNAME) TYPE(*CHAR) LEN(256) /* CALLPRC */
DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERROR) TYPE(*LGL) VALUE(‘0’)
DCL VAR(&PGMERROR) TYPE(*CHAR) VALUE(‘-‘)
DCL VAR(&DUMP) TYPE(*LGL) VALUE(‘0’)
DCL VAR(&SUBRNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERR_PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&ERR_TEXT) TYPE(*CHAR) LEN(100) /* For handled +
errors only */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGDTALEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&MSG) TYPE(*CHAR) LEN(1024)
DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&SECLVL) TYPE(*CHAR) LEN(1024)
DCL VAR(&SECLVLLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGKEYRQS) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&SD_PGMSDR) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&SENDER 27)
/* DCL VAR(&TOMSGQ) TYPE(*CHAR) LEN(10) */
/* DCL VAR(&TOMSGQLIB) TYPE(*CHAR) LEN(10) */

/* Constants */
DCL VAR(&LOOP) TYPE(*LGL) VALUE(‘1’)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X’00’)
DCL VAR(&QUOTE) TYPE(*CHAR) LEN(1) VALUE(X’7D’)

/* Global monitor for error messages not handled */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

/* Retrieve program name & library */
CHGVAR VAR(%BIN(&DATA 1 4)) VALUE(80)
CHGVAR VAR(%BIN(&DATA 5 4)) VALUE(80)
CHGVAR VAR(%BIN(&DATA 9 4)) VALUE(0)
CHGVAR VAR(%BIN(&DATA 13 4)) VALUE(0)
CALLPRC PRC(‘_MATPGMNM’) PARM((&DATA))
CHGVAR VAR(&PGMNAME) VALUE(%SST(&DATA 51 10))
CHGVAR VAR(&PGMLIB) VALUE(%SST(&DATA 19 10))

/* Retrieve job attributes */
RTVJOBA JOB(&JOBNAME) USER(&JOBUSER) NBR(&JOBNBR)

/* Check parameters */
IF COND((&PMOD *EQ ‘ ‘) *AND (&PMODLIB *NE ‘ ‘)) THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘No module name specified.’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND((&PMOD *EQ ‘*ALLBNDMOD’) *AND (&PMODLIB +
*NE ‘ ‘)) */

/* Check program type */
SELECT
WHEN COND(&POBJTYPE *EQ ‘*PGM’) THEN(DO)
CHGVAR VAR(&PGMI0100QO) VALUE(&PQOBJ)
CALLSUBR SUBR(RTVPGMINF) RTNVAL(&RTVPGMINF)
SELECT
WHEN COND(&RTVPGMINF *EQ -1) THEN(DO) /* API +
error */
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&RTVPGMINF *EQ -1) */
WHEN COND(&RTVPGMINF *EQ 0) THEN(DO) /* Ok */
IF COND(&PGMTYPE *NE ‘B’) THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘Program’ *BCAT +
&POBJ *BCAT ‘in library’ *BCAT +
&POBJLIB *BCAT ‘is not an ILE +
program.’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&PGMTYPE *NE ‘B’) */
ENDDO
OTHERWISE CMD(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘Invalid return +
code from subroutine’ *BCAT +
&SUBRNAME *TCAT ‘.’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
CHGVAR VAR(&DUMP) VALUE(‘1’) /* Dump enabled */
GOTO CMDLBL(DIAG)
ENDDO /* OTHERWISE */
ENDSELECT
ENDDO /* COND(&POBJTYPE *EQ ‘*PGM’) */
WHEN COND(&POBJTYPE *EQ ‘*SRVPGM’) THEN(DO)
CHGVAR VAR(&SPGI0100QO) VALUE(&PQOBJ)
CALLSUBR SUBR(RTVSRVPGMI) RTNVAL(&RTVSRVPGMI)
SELECT
WHEN COND(&RTVSRVPGMI *EQ -1) THEN(DO) /* API +
error */
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&RTVSRVPGMI *EQ -1) */
WHEN COND(&RTVPGMINF *EQ 0) THEN(DO) /* Ok */
ENDDO
OTHERWISE CMD(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘Invalid return +
code from subroutine’ *BCAT +
&SUBRNAME *TCAT ‘.’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
CHGVAR VAR(&DUMP) VALUE(‘1’) /* Dump enabled */
GOTO CMDLBL(DIAG)
ENDDO /* OTHERWISE */
ENDSELECT
ENDDO /* COND(&POBJTYPE *EQ ‘*SRVPGM’) */
OTHERWISE CMD(DO) /* ??? */
CHGVAR VAR(&MSGDTA) VALUE(‘Program type ”’ *CAT +
&POBJTYPE *TCAT ”’ unknown.’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
CHGVAR VAR(&DUMP) VALUE(‘1’) /* Dump enabled */
GOTO CMDLBL(DIAG)
ENDDO
ENDSELECT

/* Check TODIR parameter */
CHGVAR VAR(&STATPATH) VALUE(&PTODIR *TCAT &NULL)
CALLPRC PRC(‘stat64’) PARM((&STATPATH) (&STATBUFFER)) +
RTNVAL(&STATRTNVAL)
IF COND(&STATRTNVAL *NE 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPFA0A9’) /* Object not found */
CALLPRC PRC(‘strlen’) PARM((&STATPATH)) RTNVAL(&LENINT)
CHGVAR VAR(%BIN(&MSGDTA 1 4)) VALUE(&LENINT)
CHGVAR VAR(%SST(&MSGDTA 5 &LENINT)) VALUE(%SST(&PTODIR +
1 &LENINT))
CHGVAR VAR(&ERR_PGM) VALUE(‘stat64’)
CHGVAR VAR(&SUBRNAME) VALUE(‘MAIN’)
CHGVAR VAR(&ERR_TEXT) VALUE(‘PROCEDURE(‘ *CAT &ERR_PGM +
*TCAT ‘)@SUBR(‘ *CAT &SUBRNAME *TCAT ‘):’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&STATRTNVAL *NE 0) */
ELSE CMD(DO)
IF COND(&STATOBJTYP *NE ‘*DIR’) THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘TODIR parameter must be +
a directory (‘ *CAT &QUOTE *CAT +
&STATOBJTYP *TCAT &QUOTE *CAT ‘).’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&STATOBJTYP *NE ‘*DIR’) */
ENDDO /* COND(&STATRTNVAL *EQ 0) */

/* Check last &PTODIR char */
CALLPRC PRC(‘strlen’) PARM((&STATPATH)) RTNVAL(&LENINT)
IF COND(%SST(&STATPATH &LENINT 1) *NE ‘/’) THEN(DO)
CHGVAR VAR(&PCMLDIR) VALUE(&PTODIR *TCAT ‘/’)
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *NE ‘/’) */
ELSE CMD(DO)
CHGVAR VAR(&PCMLDIR) VALUE(&PTODIR)
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *EQ ‘/’) */

/* Retrieve PCML */
IF COND(&PMOD *EQ ‘*ALLBNDMOD’) THEN(DO)
CHGVAR VAR(&MODULE) VALUE(&PMOD)
ENDDO /* COND(&PMOD *EQ ‘*ALLBNDMOD’) */
ELSE CMD(DO)
CHGVAR VAR(&MODULE) VALUE(&PMODLIB *TCAT ‘/’ *CAT &PMOD)
ENDDO /* COND(&PMOD *NE ‘*ALLBNDMOD’) */
CHGVAR VAR(&MSGID) VALUE(‘CPI8859’)
CHGVAR VAR(&MSGDTA) VALUE(‘Retrieving Program Call Markup +
Language (PCML) data for MOD(‘ *CAT &MODULE +
*TCAT ‘) in’ *BCAT %SST(&POBJTYPE 2 8) *TCAT ‘(‘ +
*CAT &POBJLIB *TCAT ‘/’ *CAT &POBJ *TCAT ‘)…’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*STATUS)
CHGVAR VAR(&RPII0100QO) VALUE(&PQOBJ)
CHGVAR VAR(&RPII0100OT) VALUE(&POBJTYPE)
CHGVAR VAR(&RPII0100QM) VALUE(&PQMOD)
CALLSUBR SUBR(RTVPCML) RTNVAL(&RTVPCML)
SELECT
WHEN COND(&RTVPCML *EQ -1) THEN(DO) /* API error */
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&RTVPCML *EQ -1) */
WHEN COND(&RTVPCML *EQ 0) THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE(‘Program Call Markup +
Language (PCML) not found for MOD(‘ *CAT +
&MODULE *TCAT ‘) in’ *BCAT %SST(&POBJTYPE +
2 8) *TCAT ‘(‘ *CAT &POBJLIB *TCAT ‘/’ +
*CAT &POBJ *TCAT ‘).’)
CHGVAR VAR(&PGMERROR) VALUE(‘1’) /* *ESCAPE */
GOTO CMDLBL(DIAG)
ENDDO /* COND(&RTVPCML *EQ 0) */
OTHERWISE CMD(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPI8859’)
CHGVAR VAR(&MSGDTA) VALUE(‘Program Call Markup +
Language (PCML) retrieved:’ *BCAT +
%CHAR(&RTVPCML) *TCAT ‘.’)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*COMP)
ENDDO /* OTHERWISE */
ENDSELECT

CALLSUBR SUBR(CLEANUP)

GOTO CMDLBL(RETURN)

DIAG:
IF COND(&ERR_TEXT *NE ‘ ‘) THEN(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&ERR_TEXT) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
ENDDO /* COND(&ERR_TEXT *NE ‘ ‘) */

IF COND(&MSGID *EQ ‘ ‘) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(‘CPF9897’)
ENDDO /* COND(&MSGID *EQ ‘ ‘) */

SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*SAME (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)

IF COND(&PGMERROR *EQ ‘-‘) THEN(DO)
CHGVAR VAR(&PGMERROR) VALUE(‘0’) /* *DIAG */
ENDDO /* COND(&PGMERROR *EQ ‘-‘) */

ERROR:
IF COND(&ERROR *EQ ‘1’) THEN(RETURN)

CHGVAR VAR(&ERROR) VALUE(‘1’)

RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES) MSG(&MSG) +
MSGLEN(&MSGLEN) SECLVL(&SECLVL) +
SECLVLLEN(&SECLVLLEN) MSGDTA(&MSGDTA) +
MSGDTALEN(&MSGDTALEN) MSGID(&MSGID) +
RTNTYPE(&RTNTYPE) MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)

IF COND((&PGMERROR *EQ ‘-‘) *OR (&DUMP)) THEN(DO) /* +
Global MONMSG or forced dump */
CHGVAR VAR(&ERR_TEXT) VALUE(‘ ‘) /* Handled errors only */
OVRPRTF FILE(QPPGMDMP) USRDTA(&PGMNAME) SPLFOWN(*JOB) +
OVRSCOPE(*CALLLVL)
MONMSG MSGID(CPF0000)
DMPCLPGM
MONMSG MSGID(CPF0000)
DLTOVR FILE(QPPGMDMP) LVL(*)
MONMSG MSGID(CPF0000)
ENDDO /* COND(&PGMERROR *NE ‘0’) */

CALLSUBR SUBR(CLEANUP)

/* 02: Diagnostic – 15: Escape (exception already handled at time of RCVMSG) +
– 17: Escape (exception not handled at time of RCVMSG) */
IF COND((&RTNTYPE *EQ ’02’) *OR (&RTNTYPE *EQ ’15’) +
*OR (&RTNTYPE *EQ ’17’)) THEN(DO)

IF COND(&PGMERROR *EQ ‘0’) THEN(DO)
/* Set DIAGNOSTIC message */
CHGVAR VAR(&MSGTYPE) VALUE(‘*DIAG’)
ENDDO /* COND(&PGMERROR *EQ ‘0’) */
ELSE CMD(DO)
/* Set ESCAPE message */
CHGVAR VAR(&MSGTYPE) VALUE(‘*ESCAPE’)
ENDDO /* COND(&PGMERROR *NE ‘0’) */

SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV (*)) +
TOMSGQ(*TOPGMQ) MSGTYPE(&MSGTYPE)
MONMSG MSGID(CPF0000)

ENDDO /* COND((&RTNTYPE *EQ ’02’) *OR (&RTNTYPE *EQ +
’15’) *OR (&RTNTYPE *EQ ’17’)) */

/* Normal exit */
RETURN:
RETURN

/* SUBR(RTVPGMINF): Start ********************************************/

RTVPGMINF: SUBR SUBR(RTVPGMINF)

CHGVAR VAR(&SUBRNAME) VALUE(‘RTVPGMINF’)
CHGVAR VAR(&RTVPGMINF) VALUE(0)

CHGVAR VAR(&AEBYTPRO) VALUE(1040) /* &APIERROR */
CHGVAR VAR(&AEBYTAVL) VALUE(0)

CALL PGM(QCLRPGMI) PARM(&PGMI0100V &PGMI0100L +
‘PGMI0100’ &PGMI0100QO &APIERROR)

IF COND(&AEBYTAVL *NE 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(&AEEXCPID)
CHGVAR VAR(&MSGDTA) VALUE(&AEEXCPDTA)
CHGVAR VAR(&ERR_PGM) VALUE(‘QCLRPGMI’)
CHGVAR VAR(&ERR_TEXT) VALUE(‘API(‘ *CAT &ERR_PGM +
*TCAT ‘)@SUBR(‘ *CAT &SUBRNAME *TCAT ‘):’)
RTNSUBR RTNVAL(-1)
ENDDO /* COND(&AEBYTAVL *NE 0) */

ENDSUBR RTNVAL(&RTVPGMINF)

/* SUBR(RTVPGMINF): End **********************************************/

/* SUBR(RTVSRVPGMI): Start *******************************************/

RTVSRVPGMI: SUBR SUBR(RTVSRVPGMI)

CHGVAR VAR(&SUBRNAME) VALUE(‘RTVSRVPGMI’)
CHGVAR VAR(&RTVSRVPGMI) VALUE(0)

CHGVAR VAR(&AEBYTPRO) VALUE(1040) /* &APIERROR */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QBNRSPGM) PARM(&SPGI0100V &SPGI0100L +
‘SPGI0100’ &SPGI0100QO &APIERROR)

IF COND(&AEBYTAVL *NE 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(&AEEXCPID)
CHGVAR VAR(&MSGDTA) VALUE(&AEEXCPDTA)
CHGVAR VAR(&ERR_PGM) VALUE(‘QBNRSPGM’)
CHGVAR VAR(&ERR_TEXT) VALUE(‘API(‘ *CAT &ERR_PGM +
*TCAT ‘)@SUBR(‘ *CAT &SUBRNAME *TCAT ‘):’)
RTNSUBR RTNVAL(-1)
ENDDO /* COND(&AEBYTAVL *NE 0) */

ENDSUBR RTNVAL(&RTVSRVPGMI)

/* SUBR(RTVSRVPGMI): End *********************************************/

/* SUBR(RTVPCML): Start **********************************************/

RTVPCML: SUBR SUBR(RTVPCML)

CHGVAR VAR(&SUBRNAME) VALUE(‘RTVPCML’)
CHGVAR VAR(&RTVPCML) VALUE(0)

CHGVAR VAR(&USRSPC) VALUE(&PGMNAME)
CHGVAR VAR(&USRSPCLIB) VALUE(‘QTEMP’)

/* Delete user space */
DLTUSRSPC USRSPC(&USRSPCLIB/&USRSPC)
MONMSG MSGID(CPF2105) EXEC(DO)
RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES)
ENDDO

/* Create user space */
CHGVAR VAR(&USEXTATR) VALUE(&SUBRNAME)
CHGVAR VAR(&USINITSIZ) VALUE(8)
CHGVAR VAR(&USINITVAL) VALUE(X’00’)
CHGVAR VAR(&USPUBAUT) VALUE(‘*EXCLUDE’)
CHGVAR VAR(&USTEXT) VALUE(‘Pgm(‘ *CAT &PGMNAME *TCAT +
‘) SubR(‘ *CAT &SUBRNAME *TCAT ‘)’)
CHGVAR VAR(&USREPLACE) VALUE(‘*YES’)
CHGVAR VAR(&AEBYTPRO) VALUE(0) /* MONMSG */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QUSCRTUS) PARM(&QUSRSPC &USEXTATR +
&USINITSIZ &USINITVAL &USPUBAUT &USTEXT +
&USREPLACE &APIERROR)

/* Retrieve pointer to user space */
CHGVAR VAR(&AEBYTPRO) VALUE(0) /* MONMSG */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QUSPTRUS) PARM(&QUSRSPC &USPTR &APIERROR)

/* Retrieve the number of bytes of data available to be returned */
CHGVAR VAR(&AEBYTPRO) VALUE(1040) /* &APIERROR */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QBNRPII) PARM(&USDTA &USINITSIZ ‘RPII0100’ +
&RPII0100QO &RPII0100OT &RPII0100QM &APIERROR)

IF COND(&AEBYTAVL *NE 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(&AEEXCPID)
CHGVAR VAR(&MSGDTA) VALUE(&AEEXCPDTA)
CHGVAR VAR(&ERR_PGM) VALUE(‘QBNRPII’)
RTNSUBR RTNVAL(-1)
ENDDO /* COND(&AEBYTAVL *NE 0) */

CHGVAR VAR(&HDPTR) VALUE(&USPTR)

/* Increase user space size and enable automatic extendibility +
(dynamic memory allocation) */
CHGVAR VAR(&USATRREC) VALUE(2) /* Number of variable +
length records */
CHGVAR VAR(&USATRKEY1) VALUE(1) /* Key: Space size */
CHGVAR VAR(&USATRLEN1) VALUE(4) /* Length of data */
CHGVAR VAR(&USATRDTA1) VALUE(&HDBYTAVL) /* Data */
CHGVAR VAR(&USATRKEY2) VALUE(3) /* Key: Automatic +
extendibility */
CHGVAR VAR(&USATRLEN2) VALUE(1) /* Length of data */
CHGVAR VAR(&USATRDTA2) VALUE(‘1’) /* Data */
CHGVAR VAR(&AEBYTPRO) VALUE(0) /* MONMSG */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QUSCUSAT) PARM(&USRTNLIB &QUSRSPC &USCHGATR +
&APIERROR)

/* Retrieve program interface information */
CHGVAR VAR(&AEBYTPRO) VALUE(1040) /* &APIERROR */
CHGVAR VAR(&AEBYTAVL) VALUE(0)
CALL PGM(QBNRPII) PARM(&USDTA &HDBYTAVL ‘RPII0100’ +
&RPII0100QO &RPII0100OT &RPII0100QM &APIERROR)

IF COND(&AEBYTAVL *NE 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(&AEEXCPID)
CHGVAR VAR(&MSGDTA) VALUE(&AEEXCPDTA)
CHGVAR VAR(&ERR_PGM) VALUE(‘QBNRPII’)
CHGVAR VAR(&ERR_TEXT) VALUE(‘API(‘ *CAT &ERR_PGM +
*TCAT ‘)@SUBR(‘ *CAT &SUBRNAME *TCAT ‘):’)
RTNSUBR RTNVAL(-1)
ENDDO /* COND(&AEBYTAVL *NE 0) */

CHGVAR VAR(&HDPTR) VALUE(&USPTR)
CHGVAR VAR(&ENT_OFF) VALUE(&HDFSTOFF)

SNDPGMMSG MSG(‘Program Call Markup Language (PCML) +
found:’ *BCAT %CHAR(&HDNBRENT) *TCAT ‘.’)

DOFOR VAR(&I) FROM(1) TO(&HDNBRENT)
CHGVAR VAR(&ENPTR) VALUE(&USPTR)
CHGVAR VAR(&INPTR) VALUE(&USPTR) /* */
CHGVAR VAR(%OFFSET(&ENPTR)) VALUE(%OFFSET(&ENPTR) + +
&ENT_OFF)
CHGVAR VAR(&ENT_OFF) VALUE(&ENOFFNXT)
CHGVAR VAR(%OFFSET(&INPTR)) VALUE(%OFFSET(&INPTR) + +
&ENOFFINF)
CHGVAR VAR(&PCMLROWLEN) VALUE(0)
CHGVAR VAR(&PCMLROWLVL) VALUE(0)
CHGVAR VAR(&PCMLLEN) VALUE(0)
CHGVAR VAR(&PCMLSTMF) VALUE(&PCMLDIR *TCAT &POBJ +
*TCAT ‘_’ *CAT &ENMODNAM *TCAT ‘.pcml’)
RMVLNK OBJLNK(&PCMLSTMF)
MONMSG MSGID(CPFA0A9)
DOWHILE COND(&PCMLLEN *LT &ENLENINF)
CHGVAR VAR(&PCMLROWLEN) VALUE(%SCAN(‘>’ &INDTA))
IF COND(&PCMLROWLEN *GT 0) THEN(DO)
CHGVAR VAR(&PCMLROW) VALUE(%SST(&INDTA 1 +
&PCMLROWLEN))
CHGVAR VAR(%OFFSET(&INPTR)) +
VALUE(%OFFSET(&INPTR) + &PCMLROWLEN)
IF COND(%SST(&PCMLROW 1 2) *EQ ‘</’) THEN(DO)
CHGVAR VAR(&PCMLROWLVL) VALUE(&PCMLROWLVL – 1)
ENDDO /* COND(%SST(&PCMLROW 1 2) *EQ ‘</’) */
CHGVAR VAR(&SQL) VALUE(‘CALL +
QSYS2.IFS_WRITE(PATH_NAME => ”’ +
*CAT &PCMLSTMF *TCAT ”’, LINE => +
SPACE(‘ *TCAT %CHAR(&PCMLROWLVL) +
*BCAT ‘* 3) CONCAT ”’ *CAT +
%TRIMR(&PCMLROW) *TCAT ”’, +
FILE_CCSID =>’ *BCAT +
%CHAR(&PSTMFCCSID) *TCAT ‘, +
OVERWRITE => ”APPEND”, +
END_OF_LINE => ”’ *CAT +
%SST(&PSTMFEOL 2 4) *TCAT ”’)’)
RUNSQL SQL(&SQL) COMMIT(*NONE)
IF COND(%SST(&PCMLROW 1 6) *EQ ‘<pcml’ +
*OR %SST(&PCMLROW 1 9) *EQ +
‘<program’ *OR %SST(&PCMLROW 1 8) +
*EQ ‘<struct’) THEN(DO)
CHGVAR VAR(&PCMLROWLVL) +
VALUE(&PCMLROWLVL + 1)
ENDDO /* COND(%SST(&PCMLROW 1 6) *EQ +
‘<pcml’ *OR %SST(&PCMLROW 1 9) +
*EQ ‘<program’ *OR %SST(&PCMLROW +
1 8) *EQ ‘<struct’) */
ENDDO /* COND(&amp;ampPCMLROWLEN *GT 0) */
CHGVAR VAR(&amp;ampPCMLLEN) VALUE(&amp;ampPCMLLEN + &amp;ampPCMLROWLEN)
ENDDO /* DOUNTIL */
CHGVAR VAR(&amp;ampMSGID) VALUE(‘CPI8859’)
CHGVAR VAR(%SST(&amp;ampMSGDTA 1 256)) VALUE(‘Program Call +
Markup Language (PCML) data for MOD(‘ *CAT +
&amp;ampENMODLIB *TCAT ‘/’ *CAT &amp;ampENMODNAM *TCAT +
‘) in’ *BCAT %SST(&amp;ampPOBJTYPE 2 8) *TCAT ‘(‘ +
*CAT &amp;ampPOBJLIB *TCAT ‘/’ *CAT &amp;ampPOBJ *TCAT +
‘) copied to file ”’ *CAT &amp;ampPCMLSTMF *TCAT +
”’.’)
SNDPGMMSG MSGID(&amp;ampMSGID) MSGF(QCPFMSG) MSGDTA(&amp;ampMSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
ENDDO /* DOFOR */
CHGVAR VAR(&amp;ampRTVPCML) VALUE(&amp;ampHDNBRENT)

ENDSUBR RTNVAL(&amp;ampRTVPCML)

/* SUBR(RTVPCML): End ************************************************/

/* SUBR(CLEANUP): Start **********************************************/

CLEANUP: SUBR SUBR(CLEANUP)

CHGVAR VAR(&amp;ampSUBRNAME) VALUE(‘CLEANUP’)

IF COND((&amp;ampUSRSPC *NE ‘ ‘) *AND (&amp;ampUSRSPCLIB *NE ‘ +
‘)) THEN(DO)
DLTUSRSPC USRSPC(&amp;ampUSRSPCLIB/&amp;ampUSRSPC)
MONMSG MSGID(CPF0000)
ENDDO /* COND((&amp;ampUSRSPC *NE ‘ ‘) *AND (&amp;ampUSRSPCLIB *NE +
‘ ‘)) */

ENDSUBR RTNVAL(0)

/* SUBR(CLEANUP): End ************************************************/

ENDPGM:
ENDPGM

References

Program Call Markup Language
PCML Syntax
How to compile an RPG module or program with PCML included in the object
Retrieve Program Interface Information (QBNRPII) API
See the PCML that is embedded in a program or service program
Retrieve Program Information (QCLRPGMI) API
Retrieve Service Program Information (QBNRSPGM) API
Create User Space (QUSCRTUS) API
Retrieve Pointer to User Space (QUSPTRUS) API
Change User Space Attributes (QUSCUSAT) API
IFS_WRITE, IFS_WRITE_BINARY, and IFS_WRITE_UTF8 procedures

L’articolo How to extract program interface information (PCML) embedded in programs or service programs proviene da BlogFaq400.

Last Updated on 10 March 2023 by Roberto De Pedrini

The sources (SQL statement) of this post are available on Github at this link: https://github.com/Faq400Git/Create_Display_Journal_Table_View

Personally I am a big fan of IBM i Services, that series of SQL Functions (UDF and UDTF) and Stored Procedures which, with each Technology Refresh, is enriched in number and functionality.

The QSYS2.DISPLAY_JOURNAL is a UDTF now present since 7.1 of the operating system, and is an excellent alternative to the DSPJRN command to query the journal receiver entries.

Querying Journal events has never been so simple: a SQL statement is able to extract from a Journal (or rather from the Journal Receivers of a Journal) all the events concerning one or more tables under control.

As long as it is a question of querying information about the event on the table (for example event type (insert/delete/update..), event date/time, user, job etc) QSYS2.DISPLAY_JOURNAL is really great, but if we need interpreting the contents of the ENTRY_DATA field (the Blob field with the image of the record) is not exactly that immediate.

Googling here and there I found several ways to read/interpret the contents of this ENTRY_DATA field:

The official IBM site recommends using the SQL INTEPRET function, mapping the fields of interest to the ENTRY_DATA Blob : IBM Support – How to extract and search for ENTRY_DATA in DISPLAY_JOURNAL table function : excellent, INTERPRET allows us to extract our information from that BLOB field, whether they are in CHAR, VARCHAR, DECIMAL, NUMERIC fields, etc. The problem is to retrieve the “offsets” and “lengths” of each field and set the INTERPRET statement accordingly
The great Simon Hutchinson, in his mail “Extracting data from journals using SQL” Instead, he explains how to do it from RPG, reading the DISPLAY_JOURNAL records and mapping the ENTRY_DATA field in a DS with the same structure as our table.
Or fall back to the good old QjoRetrieveJournalEntries API: “ Retrieve Journal Entries (QjoRetrieveJournalEntries) API “
Even this technique proposed by Sam Lennon could be an alternative: “ Journal Entries Exposed! JOESD Made Readable ! “

Despite my searches on Google I have never found anyone who allows me to read and interpret the Journal Entries directly with SQL without going crazy in mapping field to field according to the table of my interest.

So here’s the idea: create a SQL Stored Procedure that reads the names, types, lengths and offsets of the fields from the SYSCOLUMNS catalog and automatically creates a SQL View on the QSYS2.DISPLAY_JOURNAL table function … in short, something that does the dirty work for me of mapping the entire ENTRY_DATA field according to the table concerned.

Once the Stored Procedure has been created, it will be sufficient to recall it by passing it the following parameters:

Journal library
Table name (System Name or SQL Name)
Journal library
Journal name
Library where you want to create the View
Name of the View
Flag Y/N for any REPLACE of the View
Global Variable (or hsot variable from SQL Embedded) where to return the SQL statement of the CREATE VIEW (optional)

call FAQ400.CREATE_DISPLAY_JOURNAL_TABLE_VIEW(MYTABLE_LIBRARY => ‘FAQ400JOU’, MYTABLE_NAME => ‘MYSAMPLETABLE’, MYJOURNAL_LIBRARY => ‘FAQ400JOU’, MYJOURNAL_NAME => ‘QSQJRN’, MYVIEW_LIBRARY => ‘FAQ400JOU’, MYVIEW_NANDACEREPAMPL2 => ‘V__TABLEMYS ‘Y’, MYCMD => FAQ400.GV_VARCHAR);

And then query the view to see the journal entries for the relevant table:

select * from FAQ400JOU.V_MYSAMPLETABLE_AUDIT;

Getting something similar to these two images

The source of the CREATE_DISPLAY_JOURNAL_TABLE_VIEW stored procedure, and some examples of use, can be found in my Github at this link: https://github.com/Faq400Git/Create_Display_Journal_Table_View

—
Roberto De Pedrini
Faq400.com

L’articolo Create SQL Views to interpret QSYS2.DISPLAY_JOURNAL proviene da BlogFaq400.

In this month’s session we covered practical use cases for events and event listeners, which can be fired from within your app or from another app for enhanced functionality.