Month: March 2023

Posted on

How to extract program interface information (PCML) embedded in programs or service programs

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

Related Posts

DB2 for i SQL – String Manipulation – POSSTR-LOCATE-LOCATE_IN_STRING (EN)

Introduction Often, in our applications, we need to work with text strings, and DB2 SQL can come in very useful Read more


DB2 for i – FAQ & Howtos (EN)

DB2 Database and SQL … maybe the most important things on IBM i platform: here’s a collection of FAQs, tips Read more


IBM i 7.4 Announcement (En)

Comes directly with the Easter egg this IBM announcement for the news of the IBM i 7.4 version, iNext version Read more


Generated Always Columns (EN)

Introduction “Generated Always Column”: are columns, table fields, filled by DB2 engine: something like columns with a default value but Read more

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

Posted on

How and When To Export/Backup Your IBM Installation Manager AND WebSphere Application Server Installation and Profile Data on the IBM i?

Question

How and when to export/backup your IBM Installation Manager and WebSphere Application Server Installation Data on the IBM i?
This document applies to the IBM WebSphere Application Server v8.5.x and v9.0.x Traditional products on the IBM i OS.

Answer

It is critical to backup your IBM Installation Manager and WebSphere Application Server data on the IBM i before and after any new installations performed by the Installation Manager, which include product and fix packages. Exporting your Installation Manager’s and WebSphere Application Server’s installation and profile data before and after an installation process protects your Installation Manager’s and WebSphere Application Server’s installation data and ensures you always have a good backup in case the installation data becomes corrupted or is unusable. It is also recommended a full system save be performed weekly (at a minimum) to protect your entire IM and WebSphere Application Server environments.

The Installation Manager’s and/or WebSphere Application Server’s installation data can become corrupted if an Installation Manager installation process ends unexpectedly preventing the Installation Manager rollback process from completing successfully. If this occurs, the installation package related to the installation process that failed will become unusable and any further installation or update attempts will fail.

For example, your 5250 green screen session is accidentally closed or Internet connectivity is lost when you are in the middle of an IBM WebSphere Application Server interactive fix pack install. This will cause your device session to end and the fix pack install process to end suddenly preventing the Installation Manager rollback process from completing. As a result, the installation data for the IBM WebSphere Application Server product package you were attempting to update is now corrupted and unusable. You would need to restore the Installation Manager’s and WebSphere Application Server’s installation data to a state before the original fix pack installation attempt failed in order to resolve the issue. If this is not possible, you might have to reinstall the entire product package (WebSphere Application Server). Hence, why it is so important to perform a backup of the installation data before and after any installation event.

If the Installation Manager’s and WebSphere Application Server’s installation data was saved/backed up/exported prior to it becoming corrupted, it can be restored from the save file/tape/export file to allow the Installation Manager and WebSphere Application Server to function properly again. Please refer to the “How To Restore Your IBM Installation Manager and WebSphere Application Server Installation Data on the IBM i?” IBM Software Technical Document for more information on the Installation Manager and WebSphere Application Server installation data restore process.

The following steps save the Installation Manager’s and WebSphere Application Server’s installation and profile data to save files. The Installation Manager’s installation data paths being saved are /QIBM/InstallationManager, /QIBM/ProdData/InstallationManager, and /QIBM/UserData/InstallationManager and their directory subtrees. The WebSphere Application Server’s installation and profile data paths and libraries being saved is based on your installation’s custom configuration.

Steps to save and backup your IBM Installation Manager and WebSphere Application Server installation and profile data:

NOTE: Make sure the QWASx subsystem is ended prior to beginning the save process.

1) Identify your WebSphere Application Server installation path and library.

STRQSH
/QIBM/WAS/bin/queryWASinstalls

The output of the command should look something like this:

—————————————————————————-
Websphere Edition:      EXPRESS                                        
Version:                8.5.5.12                                        
Installation Location:  /QIBM/ProdData/WebSphere/AppServer/V85/Express
Installation Library:   QWAS85A                                         
Default Profile Location: /QIBM/UserData/WebSphere/AppServer/V85/Express
—————————————————————————-

In the example above, the installation location is defined as “/QIBM/ProdData/WebSphere/AppServer/V85/Express”. This would be the directory you would use in place of the <INSTALL_LOCATION> variable.

<INSTALL_LOCATION> = Installation Location

In the example above, the installation library is defined as “QWAS85A”. This would be the library you would use in place of the <INSTALL_LIBRARY> variable.

<INSTALL_LIBRARY> = Installation Library
i.e. QWAS85A

<PROD_LIBRARY> = The Installation Library minus the letter.
i.e. QWAS85

In the example above, the default profile location is defined as “/QIBM/UserData/WebSphere/AppServer/V85/Express”. This would be the directory you would use in place of the <PROFILE_DATA> variable.

<PROFILE_DATA> = Default Profile Location
i.e. /QIBM/UserData/WebSphere/AppServer/V85/Express

2) Create OR clear the save files to store your installation data.

CRTSAVF QGPL/WASIFSDTA
CRTSAVF QGPL/WASINSTLIB
CRTSAVF QGPL/WASPRDLIB
CRTSAVF QGPL/IM

If the above save files already exist, you can clear them first before saving the data.

 

CLRSAVF QGPL/WASIFSDTA
CLRSAVF QGPL/WASINSTLIB
CLRSAVF QGPL/WASPRDLIB
CLRSAVF QGPL/IM

3)Save the Installation Manager and WebSphere Application Server installation data and private authorities to save files.

SAV DEV(‘/QSYS.LIB/QGPL.LIB/WASIFSDTA.FILE’) OBJ((‘<INSTALL_LOCATION>’) (‘<PROFILE_DATA>’)) PVTAUT(*YES)
i.e.
SAV DEV(‘/QSYS.LIB/QGPL.LIB/WASIFSDTA.FILE’) OBJ((‘/QIBM/ProdData/WebSphere/AppServer/V85/Express’) (‘/QIBM/UserData/WebSphere/AppServer/V85/Express’)) PVTAUT(*YES)

SAVLIB LIB(<INSTALL_LIBRARY>) DEV(*SAVF) SAVF(QGPL/WASINSTLIB) PVTAUT(*YES)
i.e.
SAVLIB LIB(QWAS85A) DEV(*SAVF) SAVF(QGPL/WASINSTLIB) PVTAUT(*YES)

SAVLIB LIB(<PROD_LIBRARY>) DEV(*SAVF) SAVF(QGPL/WASPRDLIB) PVTAUT(*YES)
i.e.
SAVLIB LIB(QWAS85) DEV(*SAVF) SAVF(QGPL/WASPRDLIB) PVTAUT(*YES)

SAV DEV(‘/QSYS.LIB/QGPL.LIB/IM.FILE’) OBJ((‘/QIBM/UserData/InstallationManager’) (‘/QIBM/ProdData/InstallationManager’)(‘/QIBM/InstallationManager’)(‘/QIBM/UserData/IMShared’)) PVTAUT(*YES)

NOTE: Repeat steps 1-3 after the fix pack installation completes successfully to save/backup your updated Installation Manager and WebSphere Application Server installation data.

[{“Line of Business”:{“code”:”LOB57″,”label”:”Power”},”Business Unit”:{“code”:”BU058″,”label”:”IBM Infrastructure w/TPS”},”Product”:{“code”:”SWG60″,”label”:”IBM i”},”ARM Category”:[{“code”:”a8m0z0000000CIDAA2″,”label”:”WebSphere Application Server-u003EInstall”}],”ARM Case Number”:””,”Platform”:[{“code”:”PF012″,”label”:”IBM i”}],”Version”:”All Version(s)”}]

Posted on

This year Liam Allen is presenting one of our Monday Workshops focused on a new topic, VS Code and IBM i. Bring your laptop. The workshop includes interactive handouts that you can take home with you! More info: #IBMi #NEUGC

This year Liam Allen is presenting one of our Monday Workshops focused on a new topic, VS Code and IBM i.
Bring your laptop. The workshop includes interactive handouts that you can take home with you!
More info: bit.ly/3JuvgE8 #IBMi neugc.org #NEUGC pic.twitter.com/yZEIcjA7fH

– NEUGC (@NEUGC)14:49 – Mar 09, 2023

Verified by MonsterInsights