Cos’è il PCML?
Il Program Call Markup Language (PCML) è un linguaggio di tag basato sull’Extensible Markup Language (XML) che descrive i parametri di input e di output di un programma o le procedure esportate di un modulo che fa parte di un programma di servizio.
Sebbene il PCML sia stato progettato per gestire le chiamate a programmi server da parte di programmi ad oggetti di tipo distribuiti si solito da piattaforme Java client, è possibile utilizzarlo anche per effettuare chiamate a programmi server da parte di programmi client che risiedono sul medesimo ambiente di quelli server.
Chi lo utilizza?
IBM Toolbox for Java include un’interfaccia di programmazione delle applicazioni (API) che interpreta il PCML, chiama il programma e semplifica il recupero dei dati restituiti dal sistema IBM i.
Un enorme vantaggio di PCML è che ti consente di scrivere meno codice. Normalmente, è necessario codice aggiuntivo per connettere, richiamare e tradurre i dati tra un server e gli oggetti IBM Toolbox per Java. Tuttavia, utilizzando PCML, le chiamate al server con le classi IBM Toolbox per Java vengono gestite automaticamente. Gli oggetti di classe PCML vengono generati dai tag PCML e aiutano a ridurre al minimo la quantità di codice da scrivere per richiamare i programmi server dall’applicazione.
I Servizi Web Integrati (IWS) di IBM i possono utilizzare il PCML incorporato in un programma o in un programma di servizio per generare un servizio web.
Come viene creato?
I compilatori ILE COBOL e ILE RPG, durante la fase di creazione del modulo, possono generare il PCML in un file di flusso, utilizzando i parametri PGMINFO(*PCML *STMF) e INFOSTMF('mymodule.pcml'), oppure nel modulo stesso (e di conseguenza nel programma che lo includerà), utilizzando PGMINFO(*PCML *MODULE), o in entrambi, specificando i parametri PGMINFO(*PCML *ALL) e INFOSTMF('mymodule.pcml').
Nota. Le medesime direttive per il compilatore possono essere inserite nel codice sorgente (in Cobol si utilizza la dichiarazione PROCESS per indicare le opzioni di compilazione da utilizzare, quindi, ad esempio: PROCESS PGMINFO(PCML MODULE), mentre in RPG si utilizza il codice operativo Ctl-Opt, quindi, ad esempio: Ctl-Opt PgmInfo(*PCML: *MODULE)).
Ovviamente, quando il PCML viene incorporato in un modulo, esso diventa parte del programma o del programma di servizio in cui il modulo viene incluso.
Se i moduli ILE RPG o ILE COBOL incorporano il PCML allora è possibile estrarlo o anche solo verificarne l’esistenza. Questo può essere fatto utilizzando l’API QBNRPII (Retrieve Program Interface Information).
CPYPCMLSTM
Il programma CPYPCMLSTM è un’implementazione in linguaggio ILE CL dell’API QBNRPII. Le informazioni sull’interfaccia programma in formato PCML vengono estratte dai moduli compilati con i parametri PGMINFO(*PCML *MODULE) o PGMINFO(*PCML *ALL) inclusi in un programma o in un programma di servizio e copiate in uno spazio utente (in modo da poter allocare dinamicamente la memoria necessaria per contenere tali informazioni) quindi trasformate nel consueto formato per una maggior leggibilità (il PCML estratto dall’API è una stringa di caratteri senza formattazione) ed infine scritte in un file di flusso su IFS utilizzando il servizio SQL IFS_WRITE di IBM i.
Ecco come si presenta il comando:
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 Di seguito una breve descrizione dei parametri (gli stessi dell’API QBNRPII, ad eccezione dei parametri TODIR, STMFCCSID, STMFEOL che vengono utilizzati dal servizio SQL IFS_WRITE per scrivere il file di flusso):
OBJ: specifica il programma o il programma di servizio che include i moduli contenenti i PCML da estrarre;OBJTYPE: specifica il tipo di oggetto da dove estrarre le informazioni le informazioni sull’interfaccia (*PGM, valore predefinito, o*SRVPGM);MODULE: specifica il modulo dal quale estrarre il PCML (il valore predefinito è*ALLBNDMOD);TODIR: specifica il percorso IFS dove scrivere il/i PCML (il/i file di flusso contenente/i il/i PCML saranno chiamatiobjectname_modulename.pcml);STMFCCSID: specifica il CCSID utilizzato nella creazione del/i/ file di flusso di output (il valrore predefinito è*UTF8);STMFEOL: specifica la sequenza di caratteri di fine riga da scrivere nel file di flusso di output (il valore predefinito è*CRLF).
Quindi, ad esempio, se si desidera recuperare tutti i moduli contenuti nel programma PGMX e scriverli nella directory /DIRZ utilizzando la codifica dei caratteri UTF-8 con ritorno a capo e avanzamento di riga (CRLF) come sequenza di terminazione della riga (valore predefinito), si deve immettere il seguente comando:
CPYPCMLSTM OBJ(PGMX) OBJTYPE(*PGM) MODULE(*ALLBNDMOD) TODIR('/DIRZ') STMFCCSID(*UTF8) STMFEOL(*CRLF)L’esecuzione di questo comando genererà tanti file di output PCML quanti sono i moduli con PCML incluso contenuti nel programma.
Se, invece, si volesse estrarre nel percorso /DIRZ il PCML estratto dal modulo LIBY/MODY collegato al programma di servizio PGMX utilizzando l’identificatore 819 del set di caratteri codificati ed il line feed come sequenza di terminazione della riga, si dovrebbe digitare:
CPYPCMLSTM OBJ(PGMX) OBJTYPE(*SRVPGM) MODULE(LIBY/MODY) TODIR('/DIRZ') STMFCCSID(*UNIX) STMFEOL(*LF)Qui sotto un esempio di output del comando e un esempio di file di output contenente un PCML estratto con il comando CPYPCMLSTM:
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>Di seguito i sorgenti del comando e del programma CLLE:
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:
ENDPGMRiferimenti
- 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 – Stringhe – POSSTR-LOCATE-LOCATE_IN_STRING (IT)
Introduzione Spesso, nelle nostre applicazioni, abbiamo la necessità di lavorare con le stringhe di testo e l'SQL del DB2 può Read more
DB2 for i & SQL – FAQ & Howto (Part. 1) (IT)
Database DB2 e SQL ... forse lo strumento più potente e completo che abbiamo sulla piattaforma IBM i: ecco una Read more
Annuncio IBM i 7.4
Arriva direttamente con l'uovo di Pasqua questo annuncio IBM per le novità della versione IBM i 7.4, versione iNext secondo Read more
Generated Always Columns – Approfondimenti (IT)
Introduzione "Generated Always Column": sono colonne, campi, di una tabella il cui contenuto è controllato direttamente dal sistema ... e Read more
