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 calledobjectname_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("E) 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 "E *CAT +
&STATOBJTYP *TCAT "E *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(&PCMLROWLEN *GT 0) */
CHGVAR VAR(&PCMLLEN) VALUE(&PCMLLEN + &PCMLROWLEN)
ENDDO /* DOUNTIL */
CHGVAR VAR(&MSGID) VALUE('CPI8859')
CHGVAR VAR(%SST(&MSGDTA 1 256)) VALUE('Program Call +
Markup Language (PCML) data for MOD(' *CAT +
&ENMODLIB *TCAT '/' *CAT &ENMODNAM *TCAT +
') in' *BCAT %SST(&POBJTYPE 2 8) *TCAT '(' +
*CAT &POBJLIB *TCAT '/' *CAT &POBJ *TCAT +
') copied to file ''' *CAT &PCMLSTMF *TCAT +
'''.')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
ENDDO /* DOFOR */
CHGVAR VAR(&RTVPCML) VALUE(&HDNBRENT)
ENDSUBR RTNVAL(&RTVPCML)
/* SUBR(RTVPCML): End ************************************************/
/* SUBR(CLEANUP): Start **********************************************/
CLEANUP: SUBR SUBR(CLEANUP)
CHGVAR VAR(&SUBRNAME) VALUE('CLEANUP')
IF COND((&USRSPC *NE ' ') *AND (&USRSPCLIB *NE ' +
')) THEN(DO)
DLTUSRSPC USRSPC(&USRSPCLIB/&USRSPC)
MONMSG MSGID(CPF0000)
ENDDO /* COND((&USRSPC *NE ' ') *AND (&USRSPCLIB *NE +
' ')) */
ENDSUBR RTNVAL(0)
/* SUBR(CLEANUP): End ************************************************/
ENDPGM:
ENDPGMReferences
- 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
