Colleghi e clienti chiedono sempre più frequentemente di copiare in IFS i sorgenti dei loro programmi memorizzati su membri di file sorgente per poterli compilare utilizzando il parametro SRCSTMF disponibile per i comandi di creazione di programmi/moduli ILE o per utilizzarli, tramite condivisioni di rete, da applicazioni su altre piattaforme (Windows o Linux).
CPYSRC2IFS, questo il nome del comando, semplifica questa attività di esportazione fornendo anche qualche informazione sui membri trattati e sull’attività eseguita.
Il comando permette di copiare in una directory IFS i membri di un file sorgente o i membri di tutti i file sorgente di una libreria selezionati tramite un pattern:
Copy source file member to IFS (CPYSRC2IFS)
Immettere le scelte e premere Invio.
File . . . . . . . . . . . . . . Nome, *ALL
Library . . . . . . . . . . . *LIBL Nome, *LIBL, *CURLIB
Member . . . . . . . . . . . . . Valore carattere, *
Library ASP device name . . . . *SYSBAS Nome, *SYSBAS
Directory . . . . . . . . . . .
Create directory . . . . . . . . *NO *NO, *YES
STMF extension . . . . . . . . . *DFT Valore carattere, *DFT...
STMF CCSID . . . . . . . . . . . *PCASCII 1-65533, *PCASCII, *STDASCII
End of line characters . . . . . *CRLF Valore carattere, *CRLF...
Authority . . . . . . . . . . . *INDIR *INDIR, *DFT, *FILE...
STMF description . . . . . . . . *NO *NO, *YES
Report (CSV format) . . . . . . *NO *NO, *YES
Count physical SLOC (CBL/RPG) . *NO *NO, *YES Di seguito una breve descrizione dei parametri:
FROMFILE: specifica il file sorgente (e la libreria) contenente i membri da esportare su IFS; utilizzando *ALL come nome file è possibile selezionare tutti i file sorgenti della libreria indicata (in questo caso, per ogni file sorgente della libreria, viene sottomesso un lavoro che prima crea una directory chiamata come il file sorgente da trattare sotto la directory indicata nel parametro TODIR quindi vi copia i membri selezionati);MBR: specifica i membri da esportare (‘*’ è usato come wildcard e può essere usato in ogni posizione e anche più di una volta, ad esempio: MBR('*B*A*'));LIBASPDEV: specifica il device dell’ASP dove si trova la libreria contenente il file sorgente da esportare;TODIR: specifica il percorso della directory IFS dove copiare i membri;CRTDIR: specifica se creare (*YES) o meno (*NO, default) la directory di destinazione (indicata nel parametro TODIR);STMFEXT: specifica l’estensione da utilizzare per completare il nome del file di flusso di destinazione; è possibile indicarla espressamente (STMFEXT('.txt'), ad esempio) oppure scegliere tra: *DFT (default), per utilizzare l’estensione .MBR, *NONE, per non avere alcuna estensione e *TYPE per utilizzare il contenuto del campo TYPE (tipo origine) del membro;STMFCCSID: specifica il CCSID del file di flusso; *PCASCII è il valore di default (CCSID = 1252), in alternativa è possibile usare *STDASCII (CCSID = 819) oppure un CCSID compreso tra 1 e 65533 (i valori utilizzati dal comando CPYTOSTMF);ENDLINFMT: specifica i caratteri di fine riga; *CRLF è il valore di default, in alternativa è possibile specificare *LF, *CR, *LFCR, *FIXED (i valori utilizzati dal comando CPYTOSTMF);AUT: specifica il criterio utilizzato per assegnare l’autorizzazione agli oggetti copiati; i possibili valori sono *INDIR (valore di default), *DFT, *FILE, *INDIRFILE (anche in questo caso si tratta dei valori utilizzati dal comando CPYTOSTMF);REPORT: specifica se creare o meno un report in formato CSV (Comma-Separated Values) dei membri esportati, chiamato “#Report-JOBNUMBER-JOBUSER_JOBNAME.csv”, contenente alcune informazioni sul membro quali: libreria, file sorgente, membro, descrizione, tipo, numero di record, timestamp di creazione, timestamp di ultima modifica, dimensione in byte del file di flusso generato e spazio allocato in byte sempre del file di flusso generato ("LIBRARY";"FILE";"MEMBER";"TYPE";"TEXT";"NBRRCD";"CRT_TIMESTAMP";"LAST_CHG_TIMESTAMP";"IFS_SIZE";"IFS_ALLOC")STMFTXT: specifica se riportare (*YES) o meno (*NO, valore di default) la descrizione del membro del file sorgente nella descrizione del file di flusso di destinazione;SLOC: specifica, solo se REPORT(*YES), se stimare o meno la quantità di righe di codice fisiche (cioè senza righe di commento) per i sorgenti Cobol e RPG. In questo caso le colonne del file di report diventano: "LIBRARY";"FILE";"MEMBER";"TYPE";"TEXT";"NBRRCD";"PHYSICAL_SLOC";"CRT_TIMESTAMP";"LAST_CHG_TIMESTAMP";"IFS_SIZE";"IFS_ALLOC"Oltre al report in formato CSV, al termine dell’esecuzione, il comando visualizza un riassunto di quanto fatto in termini di numero di membri processati, record totali dei membri processati, dimensioni dei file di flusso creati (in byte) e spazio allocato per tali file di flusso (in byte). Ecco un esempio:
Member processed: 1.003 - Records: 607.422 - IFS size (byte): 25.457.910
- IFS allocated size (byte): 40.460.288Prima di procedere con la compilazione del programma (comando CRTBNDCL) occorre creare tre file con i seguenti comandi:
RUNSQL SQL('CREATE TABLE QTEMP/PFSRCLIST AS (SELECT DBXFIL FROM QADBXREF) WITH NO DATA') +
COMMIT(*NONE)RUNSQL SQL('CREATE TABLE QTEMP/MBRLIST (MBNAME CHAR(10), MBSEU2 CHAR(10), MBMTXT CHAR(50), +
MBNRCD DECIMAL(10, 0), MBCCEN CHAR(1), MBCDAT CHAR(6), MBCTIM CHAR(6), MBUPDC CHAR(1), +
MBUPDD CHAR(6), MBUPDT CHAR(6))') COMMIT(*NONE)RUNSQL SQL('CREATE TABLE QTEMP/SLOC (NUMBER NUMERIC(10, 0))') COMMIT(*NONE)Quindi, se vogliamo esportare nella directory /src/prj1 (da far creare dal comando), in “formato” Windows, tutti i sorgenti dei programmi contenuti nei membri dei file fisici sorgente presenti nella libreria PRJ1LIB, compresa la loro descrizione, e desideriamo anche che sia generato il report dell’attività, inclusa la stima delle righe fisiche di codice per i programmi in linguaggio Cobol e RPG, dobbiamo digitare il seguente comando (in italico i parametri che utilizzano i valori di default del comando):
CPYSRC2IFS FROMFILE(PRJ1LIB/*ALL) MBR(*) TODIR('/src/prj1') CRTDIR(*YES) STMFEXT(*TYPE) +
STMFCCSID(*PCASCII) ENDLINFMT(*CRLF) AUT(*INDIR) STMFTXT(*YES) REPORT(*YES) SLOC(*YES)Di seguito i sorgenti del comando e del programma CLLE:
CMD PROMPT('Copy source file member to IFS')
PARM KWD(FROMFILE) TYPE(FILE) MIN(1) PROMPT('File' 1)
PARM KWD(TODIR) TYPE(*PNAME) LEN(128) MIN(1) EXPR(*YES) +
PROMPT('Directory' 4)
PARM KWD(MBR) TYPE(*CHAR) LEN(10) DFT(*) SPCVAL((*)) +
EXPR(*YES) PROMPT('Member' 2)
PARM KWD(LIBASPDEV) TYPE(*NAME) LEN(10) DFT(*SYSBAS) +
SPCVAL((*SYSBAS)) EXPR(*YES) PROMPT('Library ASP +
device name' 3)
PARM KWD(CRTDIR) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PROMPT('Create +
directory' 5)
PARM KWD(STMFEXT) TYPE(*CHAR) LEN(10) DFT(*DFT) +
SPCVAL((*DFT) (*NONE) (*TYPE)) EXPR(*YES) +
PROMPT('STMF extension' 6)
PARM KWD(STMFCCSID) TYPE(*INT4) DFT(*PCASCII) RANGE(1 +
65533) SPCVAL((*PCASCII 1252) (*STDASCII 850)) +
EXPR(*YES) PROMPT('STMF CCSID' 7)
PARM KWD(ENDLINFMT) TYPE(*CHAR) LEN(6) DFT(*CRLF) +
SPCVAL((*CRLF) (*LF) (*CR) (*LFCR) (*FIXED)) +
EXPR(*YES) PROMPT('End of line characters' 8)
PARM KWD(AUT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*INDIR) VALUES(*INDIR *DFT *FILE *INDIRFILE) +
EXPR(*YES) PROMPT('Authority' 9)
PARM KWD(STMFTXT) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*NO *YES) EXPR(*YES) +
PROMPT('STMF description' 10)
PARM KWD(REPORT) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PROMPT('Report (CSV +
format)' 11)
PARM KWD(SLOC) TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*NO) +
VALUES(*NO *YES) EXPR(*YES) PMTCTL(LOC) +
PROMPT('Count physical SLOC (CBL/RPG)' 12)
FILE: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL)) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL) +
(*CURLIB)) EXPR(*YES) PROMPT('Library')
LOC: PMTCTL CTL(REPORT) COND((*EQ *YES)) NBRTRUE(*ALL) PGM PARM(&PFROMFILE &PTODIR &PMBR &PLIBASPDEV &PCRTDIR +
&PSTMFEXT &PSTMFCCSID &PENDLINFMT &PAUT +
&PSTMFTXT &PREPORT &PSLOC)
/* Parameters */
DCL VAR(&PFROMFILE) TYPE(*CHAR) LEN(20)
DCL VAR(&FROMFILE) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PFROMFILE 1)
DCL VAR(&FROMLIB) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&PFROMFILE 11)
DCL VAR(&PTODIR) TYPE(*CHAR) LEN(128)
DCL VAR(&PMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&PLIBASPDEV) TYPE(*CHAR) LEN(10)
DCL VAR(&PCRTDIR) TYPE(*CHAR) LEN(4)
DCL VAR(&PSTMFEXT) TYPE(*CHAR) LEN(10)
DCL VAR(&PSTMFCCSID) TYPE(*INT) LEN(4)
DCL VAR(&PENDLINFMT) TYPE(*CHAR) LEN(6)
DCL VAR(&PAUT) TYPE(*CHAR) LEN(10)
DCL VAR(&PSTMFTXT) TYPE(*CHAR) LEN(4)
DCL VAR(&PREPORT) TYPE(*CHAR) LEN(4)
DCL VAR(&PSLOC) TYPE(*CHAR) LEN(4)
/* Variables */
DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
DCL VAR(&NBRSELMBR) TYPE(*DEC) LEN(10 0)
DCL VAR(&NBRSELPFS) TYPE(*DEC) LEN(10 0)
DCL VAR(&ASPPATH) TYPE(*CHAR) LEN(11)
DCL VAR(&MBRPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&TODIR) TYPE(*CHAR) LEN(128)
DCL VAR(&STMFEXT) TYPE(*CHAR) LEN(10)
DCL VAR(&STMF) TYPE(*CHAR) LEN(256)
DCL VAR(&REPORT) TYPE(*CHAR) LEN(256)
DCL VAR(&MBRCRTCEN) TYPE(*CHAR) LEN(2)
DCL VAR(&MBRCRTDAT) TYPE(*CHAR) LEN(10)
DCL VAR(&MBRCRTTIM) TYPE(*CHAR) LEN(8)
DCL VAR(&MBRCRTTS) TYPE(*CHAR) LEN(26)
DCL VAR(&MBRCHGCEN) TYPE(*CHAR) LEN(2)
DCL VAR(&MBRCHGDAT) TYPE(*CHAR) LEN(10)
DCL VAR(&MBRCHGTIM) TYPE(*CHAR) LEN(8)
DCL VAR(&MBRCHGTS) TYPE(*CHAR) LEN(26)
DCL VAR(&MBRCNTX) TYPE(*DEC) LEN(10 0)
DCL VAR(&MBRCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&MBRCNTCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&RCDCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&RCDCNTCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&IFSSIZ) TYPE(*INT) LEN(8)
DCL VAR(&IFSSIZCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&IFSALC) TYPE(*INT) LEN(8)
DCL VAR(&IFSALCCHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&SLOCCNT) TYPE(*DEC) LEN(10 0)
DCL VAR(&SLOCCNTCHR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&SLOC) TYPE(*LGL) LEN(1)
/* Files */
DCLF FILE(PFSRCLIST) OPNID(PFSRC)
DCLF FILE(SLOC) OPNID(SLOC)
DCLF FILE(MBRLIST) OPNID(MBRINFO)
/* stat64 */
DCL VAR(&STATRTNVAL) TYPE(*INT) LEN(4)
DCL VAR(&STATPATH) TYPE(*CHAR) LEN(256)
DCL VAR(&STATBUFFER) TYPE(*CHAR) LEN(4096)
DCL VAR(&STATOBJSIZ) TYPE(*INT) STG(*DEFINED) LEN(8) +
DEFVAR(&STATBUFFER 17)
DCL VAR(&STATALCSIZ) TYPE(*UINT) STG(*DEFINED) LEN(8) +
DEFVAR(&STATBUFFER 49)
DCL VAR(&STATOBJTYP) TYPE(*CHAR) STG(*DEFINED) LEN(10) +
DEFVAR(&STATBUFFER 61)
/* strlen */
DCL VAR(&STRTMP) TYPE(*CHAR) LEN(32767)
DCL VAR(&LENINT) TYPE(*UINT) LEN(4)
/* SUBR(VFYPFSRC): Start *********************************************/
DCL VAR(&VFYPFSRC) TYPE(*INT) LEN(4)
/* QDBRTVFD */
DCL VAR(&FILD0100) TYPE(*CHAR) LEN(400)
DCL VAR(&QDBFHFLG) TYPE(*CHAR) STG(*DEFINED) LEN(1) +
DEFVAR(&FILD0100 9)
DCL VAR(&QDBFHMNUM) TYPE(*INT) STG(*DEFINED) LEN(2) +
DEFVAR(&FILD0100 48)
DCL VAR(&FILD0100L) TYPE(*INT) LEN(4) VALUE(400)
DCL VAR(&QDBFOUT) TYPE(*CHAR) LEN(20)
DCL VAR(&QDBFIN) TYPE(*CHAR) LEN(20)
DCL VAR(&QDBFRCDFMT) TYPE(*CHAR) LEN(10)
DCL VAR(&QDBFOVR) TYPE(*CHAR) LEN(1)
DCL VAR(&QDBFSYS) TYPE(*CHAR) LEN(10)
DCL VAR(&QDBFFMTTYP) TYPE(*CHAR) LEN(10)
DCL VAR(&BIT_2_ON) TYPE(*LGL) LEN(1)
DCL VAR(&BIT_4_ON) TYPE(*LGL) LEN(1)
DCL VAR(&BIT_POS) TYPE(*INT) LEN(4)
DCL VAR(&FILEATRB) TYPE(*CHAR) LEN(2)
DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(3)
DCL VAR(&NBRALLMBR) TYPE(*INT) LEN(2)
/* SUBR(VFYPFSRC): End ***********************************************/
/* SUBR(EDTNUM): Start ***********************************************/
DCL VAR(&EDTNUM) TYPE(*INT) LEN(4)
/* QECCVTEC, QECEDT */
DCL VAR(&SIZEDEC) TYPE(*DEC) LEN(15 0)
DCL VAR(&SIZECHAR) TYPE(*CHAR) LEN(19) /* +
xxx.xxx.xxx.xxx.xxx */
DCL VAR(&EDTMASK) TYPE(*CHAR) LEN(256)
DCL VAR(&EDTMASKLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&ZROBAL) TYPE(*CHAR) LEN(1)
DCL VAR(&EDTCODE) TYPE(*CHAR) LEN(1) VALUE('1')
DCL VAR(&CURRENCY) TYPE(*CHAR) LEN(1)
DCL VAR(&SRCVARPCSN) TYPE(*CHAR) LEN(4)
DCL VAR(&SRCVARDEC) TYPE(*CHAR) LEN(4)
/* SUBR(EDTNUM): End *************************************************/
/* SUBR(DUPQUOTE): Start *********************************************/
DCL VAR(&DUPQUOTE) TYPE(*INT) LEN(4)
DCL VAR(&TEXTIN) TYPE(*CHAR) LEN(50)
DCL VAR(&TEXTOUT) TYPE(*CHAR) LEN(100)
DCL VAR(&TEXT_I) TYPE(*UINT) LEN(2)
DCL VAR(&TEXT_J) TYPE(*UINT) LEN(2)
/* SUBR(DUPQUOTE): End ***********************************************/
/* RUNSQL */
DCL VAR(&SQL) TYPE(*CHAR) LEN(5000)
/* API Error & SUBR(RSTAPIERR): Start ********************************/
DCL VAR(&RSTAPIERR) TYPE(*INT) LEN(4)
DCL VAR(&APINAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PRCNAME) TYPE(*CHAR) LEN(256) /* CALLPRC */
DCL VAR(&APIERROR) TYPE(*CHAR) LEN(528)
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(512) +
DEFVAR(&APIERROR 17)
/* API Error & SUBR(RSTAPIERR): End **********************************/
/* _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)
DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) /* 0=Batch 1=Inter */
/* RCVMSG & SNDPGMMSG */
DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERROR) TYPE(*LGL) VALUE('0')
DCL VAR(&PGMERROR) TYPE(*LGL) VALUE('0')
DCL VAR(&SUBRNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERRORTEXT) TYPE(*CHAR) LEN(100)
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)
/* 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 any error messages */
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) +
TYPE(&JOBTYPE)
IF COND(&FROMFILE *NE '*ALL') THEN(DO)
/* Check library and file */
RTVOBJD OBJ(&FROMLIB/&FROMFILE) OBJTYPE(*FILE) +
OBJATR(&OBJATR)
MONMSG MSGID(CPF9810) EXEC(DO) /* Library &1 not found. */
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('Library' *BCAT &FROMLIB +
*BCAT 'not found.')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* MSGID(CPF9810) */
MONMSG MSGID(CPF9812) EXEC(DO) /* File &1 in library +
&2 not found. */
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('File' *BCAT &FROMFILE +
*BCAT 'not found in library' *BCAT +
&FROMLIB *TCAT '.')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* MSGID(CPF9801) */
IF COND(&OBJATR *NE 'PF') THEN(DO)
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('File' *BCAT &FROMFILE +
*BCAT 'in library' *BCAT &FROMLIB *BCAT +
'is not a physical file (' *CAT &OBJATR +
*TCAT ').')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&OBJATR *NE 'PF') */
/* Check file type */
CHGVAR VAR(&QDBFIN) VALUE(&PFROMFILE)
CHGVAR VAR(&QDBFOVR) VALUE('0')
CHGVAR VAR(&QDBFSYS) VALUE('*LCL')
CALLSUBR SUBR(VFYPFSRC) RTNVAL(&VFYPFSRC)
IF COND(&VFYPFSRC *NE 0) THEN(DO)
GOTO CMDLBL(ERROR)
ENDDO /* COND(&VFYPFSRC *NE 0) */
IF COND((&FILEATRB *NE 'PF') *OR (&FILETYPE *NE +
'SRC')) THEN(DO)
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('File' *BCAT &FROMFILE +
*BCAT 'in library' *BCAT &FROMLIB *BCAT +
'is not a source physical file (' *CAT +
&FILEATRB *CAT '-' *CAT &FILETYPE *CAT ').')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND((&FILEATRB *NE 'PF') *OR (&FILETYPE *NE +
'SRC') */
ENDDO /* COND(&FROMFILE *NE '*ALL') */
/* 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)
IF COND(&PCRTDIR *EQ '*YES') THEN(DO)
CRTDIR DIR(&PTODIR) DTAAUT(*INDIR) OBJAUT(*INDIR)
ENDDO /* COND(&PCRTDIR *EQ '*YES') */
ELSE CMD(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))
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&PCRTDIR *NE '*YES') */
ENDDO /* COND(&STATRTNVAL *NE 0) */
ELSE CMD(DO)
IF COND(&STATOBJTYP *NE '*DIR') THEN(DO)
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('TODIR parameter must be +
a directory (' *CAT "E *CAT +
&STATOBJTYP *TCAT "E *CAT ').')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
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(&TODIR) VALUE(&PTODIR *TCAT '/')
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *NE '/') */
ELSE CMD(DO)
CHGVAR VAR(&TODIR) VALUE(&PTODIR)
ENDDO /* COND(%SST(&STATPATH &LENINT 1) *EQ '/') */
/* Work with multiple PF-SRC */
IF COND(&FROMFILE *EQ '*ALL') THEN(DO)
/* Extract PF-SRC to be processed */
DLTF FILE(QTEMP/PFSRCLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not +
found */
CHGVAR VAR(&SQL) VALUE('CREATE TABLE QTEMP/PFSRCLIST +
AS (SELECT DBXFIL FROM QADBXREF WHERE DBXTYP +
= ''S'' AND DBXLIB = ''' *CAT &FROMLIB *TCAT +
''' ORDER BY DBXFIL) WITH DATA')
RUNSQL SQL(&SQL) COMMIT(*NONE)
/* Check PF-SRC to be processed */
RTVMBRD FILE(QTEMP/PFSRCLIST) MBR(*FIRST) +
NBRCURRCD(&NBRSELPFS)
IF COND(&NBRSELPFS *EQ 0) THEN(DO)
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('No PF-SRC found in +
library' *BCAT &FROMLIB *TCAT '.')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&NBRSELPFS *EQ 0) */
/* Read PF-SRC file */
OVRDBF FILE(PFSRCLIST) TOFILE(QTEMP/PFSRCLIST) +
MBR(*FIRST) LVLCHK(*NO) OVRSCOPE(*CALLLVL) +
SHARE(*NO)
DOWHILE COND(&LOOP)
RCVF OPNID(PFSRC)
MONMSG MSGID(CPF0864) EXEC(LEAVE)
SBMJOB CMD(CPYSRC2IFS +
FROMFILE(&FROMLIB/&PFSRC_DBXFIL) +
MBR(&PMBR) LIBASPDEV(&PLIBASPDEV) +
TODIR(&TODIR *TCAT &PFSRC_DBXFIL) +
CRTDIR(&PCRTDIR) STMFEXT(&PSTMFEXT) +
STMFCCSID(&PSTMFCCSID) +
ENDLINFMT(&PENDLINFMT) AUT(&PAUT) +
STMFTXT(&PSTMFTXT) REPORT(&PREPORT) +
SLOC(&PSLOC)) JOB(&PFSRC_DBXFIL)
ENDDO /* WHILE */
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&FROMFILE *EQ '*ALL') */
/* Set STMF extension (1) */
SELECT
WHEN COND(&PSTMFEXT *EQ '*NONE') THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE(' ')
ENDDO /* COND(&PSTMFEXT *EQ '*NONE') */
WHEN COND(&PSTMFEXT *EQ '*DFT') THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE('.MBR')
ENDDO /* COND(&PSTMFEXT *EQ '*DFT') */
OTHERWISE CMD(DO)
IF COND(%SST(&PSTMFEXT 1 1) *EQ '.') THEN(DO)
CHGVAR VAR(&STMFEXT) VALUE(&PSTMFEXT)
ENDDO /* COND(%SST(&PSTMFEXT 1 1) *EQ '.') */
ELSE CMD(DO)
CHGVAR VAR(&STMFEXT) VALUE('.' *CAT &PSTMFEXT)
ENDDO /* COND(%SST(&PSTMFEXT 1 1) *NE '.') */
ENDDO /* OTHERWISE */
ENDSELECT
/* Set MBR path (1) */
IF COND(&PLIBASPDEV *EQ '*SYSBAS') THEN(DO)
CHGVAR VAR(&ASPPATH) VALUE(' ')
ENDDO /* COND(&PLIBASPDEV *EQ '*SYSBAS') */
ELSE CMD(DO)
CHGVAR VAR(&ASPPATH) VALUE('/' *CAT &PLIBASPDEV)
ENDDO /* COND(&PLIBASPDEV *NE '*SYSBAS') */
/* Build member list in output file */
DLTF FILE(QTEMP/MEMBERLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not found */
DSPFD FILE(&FROMLIB/&FROMFILE) TYPE(*MBR) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/MEMBERLIST) +
OUTMBR(*FIRST *REPLACE)
/* Extract members to be processed */
DLTF FILE(QTEMP/MBRLIST)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not found */
CHGVAR VAR(&SQL) VALUE('CREATE TABLE QTEMP.MBRLIST AS +
(SELECT MBNAME, MBSEU2, MBMTXT, MBNRCD, MBCCEN, +
MBCDAT, MBCTIM, MBUPDC, MBUPDD, MBUPDT FROM +
QTEMP.MEMBERLIST WHERE MBNAME NOT LIKE '' %'' +
AND MBNAME LIKE REPLACE(''' *CAT &PMBR *TCAT +
''', ''*'', ''%'') ORDER BY MBNAME) WITH DATA')
RUNSQL SQL(&SQL) COMMIT(*NONE)
/* Check the number of members to be processed */
RTVMBRD FILE(QTEMP/MBRLIST) MBR(*FIRST) NBRCURRCD(&NBRSELMBR)
IF COND(&NBRSELMBR *EQ 0) THEN(DO)
IF COND((&JOBTYPE *EQ '1') *AND (&PCRTDIR *EQ +
'*YES')) THEN(DO)
RMVDIR DIR(&PTODIR) SUBTREE(*NONE)
ENDDO /* COND((&JOBTYPE *EQ '1') *AND (&PCRTDIR *EQ +
'*YES')) */
CHGVAR VAR(&MSGID) VALUE('CPF9897')
CHGVAR VAR(&MSGDTA) VALUE('No members selected.')
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
GOTO CMDLBL(CLEANUP)
ENDDO /* COND(&NBRSELMBR *EQ 0) */
/* Create report file */
IF COND(&PREPORT *EQ '*YES') THEN(DO)
DLTF FILE(QTEMP/REPORT)
MONMSG MSGID(CPF2105) /* Object &1 in &2 type *&3 not +
found */
CRTPF FILE(QTEMP/REPORT) RCDLEN(200)
IF COND(&PSLOC *EQ '*NO') THEN(DO)
CHGVAR VAR(&SQL) VALUE('INSERT INTO QTEMP.REPORT +
VALUES(''"LIBRARY";"FILE";"MEMBER";"TYPE";"T+
EXT";"NBR_RCD";"CRT_TIMESTAMP";"LAST_CHG_TIM+
ESTAMP";"IFS_SIZE";"IFS_ALLOC"'')')
ENDDO /* COND(&PSLOC *EQ '*NO') */
ELSE CMD(DO)
CHGVAR VAR(&SQL) VALUE('INSERT INTO QTEMP.REPORT +
VALUES(''"LIBRARY";"FILE";"MEMBER";"TYPE";"T+
EXT";"NBRRCD";"PHYSICAL_SLOC";"CRT_TIMESTAMP+
";"LAST_CHG_TIMESTAMP";"IFS_SIZE";"IFS_ALLOC+
"'')')
ENDDO /* COND(&PSLOC *NE '*NO') */
RUNSQL SQL(&SQL) COMMIT(*NONE)
CHGVAR VAR(&REPORT) VALUE(&TODIR *TCAT '#Report_' *CAT +
&JOBNBR *TCAT '-' *CAT &JOBUSER *TCAT '-' +
*CAT &JOBNAME *TCAT '.csv')
RMVLNK OBJLNK(&STMF)
MONMSG MSGID(CPFA0A9)
/* Create temporary file to estimate physical SLOC for Cobol and RPG */
IF COND(&PSLOC *EQ '*YES') THEN(DO)
DLTF FILE(QTEMP/SLOC)
MONMSG MSGID(CPF2105)
CHGVAR VAR(&SQL) VALUE('CREATE TABLE QTEMP/SLOC +
(NUMBER NUMERIC(10, 0))')
RUNSQL SQL(&SQL) COMMIT(*NONE)
CHGVAR VAR(&SQL) VALUE('INSERT INTO +
QTEMP/SLOC(NUMBER) VALUES(0)')
RUNSQL SQL(&SQL) COMMIT(*NONE)
OVRDBF FILE(SLOC) TOFILE(QTEMP/SLOC) MBR(*FIRST) +
LVLCHK(*NO) OVRSCOPE(*CALLLVL)
ENDDO /* COND(&PSLOC *EQ '*YES') */
ENDDO /* COND(&PREPORT *EQ '*YES') */
/* Read member list file */
OVRDBF FILE(MBRLIST) TOFILE(QTEMP/MBRLIST) MBR(*FIRST) +
LVLCHK(*NO) OVRSCOPE(*CALLLVL) SHARE(*NO)
DOWHILE COND(&LOOP)
RCVF OPNID(MBRINFO)
MONMSG MSGID(CPF0864) EXEC(LEAVE)
/* Count members */
CHGVAR VAR(&MBRCNTX) VALUE(&MBRCNTX + 1)
/* Send *INFO or *STATUS message indicating the member being processed */
CHGVAR VAR(&MSGDTA) VALUE('Processing MBR(' *CAT +
&MBRINFO_MBNAME *TCAT ') TYPE(' *CAT +
&MBRINFO_MBSEU2 *TCAT ') NBRRCD(' *CAT +
%CHAR(&MBRINFO_MBNRCD) *TCAT ') [' *CAT +
%CHAR(&MBRCNTX) *TCAT '/' *CAT +
%CHAR(&NBRSELMBR) *TCAT '|' *CAT +
%CHAR(&NBRALLMBR) *TCAT ']')
IF COND(&JOBTYPE *EQ '0') THEN(DO) /* Batch */
SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
ENDDO /* COND(&JOBTYPE *EQ '0') */
ELSE CMD(DO) /* Interactive */
SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*EXT) TOMSGQ(*TOPGMQ) MSGTYPE(*STATUS)
ENDDO /* COND(&JOBTYPE *NE '0') */
/* Set MBR path (2) */
CHGVAR VAR(&MBRPATH) VALUE(&ASPPATH *TCAT '/QSYS.LIB/' +
*CAT &FROMLIB *TCAT '.LIB/' *CAT &FROMFILE +
*TCAT '.FILE/' *CAT &MBRINFO_MBNAME *TCAT '.MBR')
/* Set STMF extension (2) & STMF path */
IF COND(&PSTMFEXT *NE '*TYPE') THEN(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT +
&MBRINFO_MBNAME *TCAT &STMFEXT)
ENDDO /* COND(&PSTMFEXT *NE '*TYPE') */
ELSE CMD(DO)
IF COND(&MBRINFO_MBSEU2 *NE ' ') THEN(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT +
&MBRINFO_MBNAME *TCAT '.' *CAT +
&MBRINFO_MBSEU2)
ENDDO /* COND(&MBRINFO_MBSEU2 *NE ' ') */
ELSE CMD(DO)
CHGVAR VAR(&STMF) VALUE(&TODIR *TCAT &MBRINFO_MBNAME)
ENDDO /* COND(&MBRINFO_MBSEU2 *EQ ' ') */
ENDDO /* COND(&PSTMFEXT *EQ '*TYPE') */
/* Copy MBR to STMF */
CPYTOSTMF FROMMBR(&MBRPATH) TOSTMF(&STMF) +
STMFOPT(*REPLACE) CVTDTA(*AUTO) +
DBFCCSID(*FILE) STMFCCSID(&PSTMFCCSID) +
ENDLINFMT(&PENDLINFMT) AUT(&PAUT)
/* Set STMF description */
IF COND(&PSTMFTXT *EQ '*YES') THEN(DO)
CHGATR OBJ(&STMF) ATR(*TEXT) VALUE(*NONE) +
TEXT(&MBRINFO_MBMTXT)
ENDDO /* COND(&PSTMFTXT *EQ '*YES') */
/* Count members */
CHGVAR VAR(&MBRCNT) VALUE(&MBRCNT + 1)
/* Count records */
CHGVAR VAR(&RCDCNT) VALUE(&RCDCNT + &MBRINFO_MBNRCD)
/* Retrieve STMF information */
CHGVAR VAR(&STATPATH) VALUE(&STMF *TCAT &NULL)
CALLPRC PRC('stat64') PARM((&STATPATH) (&STATBUFFER)) +
RTNVAL(&STATRTNVAL)
IF COND(&STATRTNVAL *EQ 0) THEN(DO)
CHGVAR VAR(&IFSSIZ) VALUE(&IFSSIZ + &STATOBJSIZ)
CHGVAR VAR(&IFSALC) VALUE(&IFSALC + &STATALCSIZ)
ENDDO /* COND(&STATRTNVAL *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&PRCNAME) VALUE('stat64')
CHGVAR VAR(&SUBRNAME) VALUE('MAIN')
CHGVAR VAR(&ERRORTEXT) VALUE(' (PRC' *BCAT &PRCNAME +
*BCAT 'in' *BCAT &SUBRNAME *TCAT ')')
GOTO CMDLBL(ERROR)
ENDDO /* COND(&STATRTNVAL *NE 0) */
/* Update report file */
IF COND(&PREPORT *EQ '*YES') THEN(DO)
CHGVAR VAR(&TEXTIN) VALUE(&MBRINFO_MBMTXT)
CALLSUBR SUBR(DUPQUOTE) RTNVAL(&DUPQUOTE)
IF COND(&MBRINFO_MBCCEN *EQ '0') THEN(DO)
CHGVAR VAR(&MBRCRTCEN) VALUE('19')
ENDDO /* COND(&MBRINFO_MBCCEN *EQ '0') */
ELSE CMD(DO)
CHGVAR VAR(&MBRCRTCEN) VALUE('20')
ENDDO /* COND(&MBRINFO_MBCCEN *NE '0') */
CHGVAR VAR(&MBRCRTDAT) VALUE(&MBRCRTCEN *CAT +
%SST(&MBRINFO_MBCDAT 1 2) *CAT '-' *CAT +
%SST(&MBRINFO_MBCDAT 3 2) *CAT '-' *CAT +
%SST(&MBRINFO_MBCDAT 5 2))
CHGVAR VAR(&MBRCRTTIM) VALUE(%SST(&MBRINFO_MBCTIM 1 +
2) *CAT '.' *CAT %SST(&MBRINFO_MBCTIM 3 2) +
*CAT '.' *CAT %SST(&MBRINFO_MBCTIM 5 2))
CHGVAR VAR(&MBRCRTTS) VALUE(&MBRCRTDAT *CAT '-' +
*CAT &MBRCRTTIM *CAT '.000000')
IF COND(&MBRINFO_MBUPDC *EQ '0') THEN(DO)
CHGVAR VAR(&MBRCHGCEN) VALUE('19')
ENDDO /* COND(&MBRINFO_MBUPDC *EQ '0') */
ELSE CMD(DO)
CHGVAR VAR(&MBRCHGCEN) VALUE('20')
ENDDO /* COND(&MBRINFO_MBUPDC *NE '0') */
CHGVAR VAR(&MBRCHGDAT) VALUE(&MBRCHGCEN *CAT +
%SST(&MBRINFO_MBUPDD 1 2) *CAT '-' *CAT +
%SST(&MBRINFO_MBUPDD 3 2) *CAT '-' *CAT +
%SST(&MBRINFO_MBUPDD 5 2))
CHGVAR VAR(&MBRCHGTIM) VALUE(%SST(&MBRINFO_MBUPDT 1 +
2) *CAT '.' *CAT %SST(&MBRINFO_MBUPDT 3 2) +
*CAT '.' *CAT %SST(&MBRINFO_MBUPDT 5 2))
CHGVAR VAR(&MBRCHGTS) VALUE(&MBRCHGDAT *CAT '-' +
*CAT &MBRCHGTIM *CAT '.000000')
/* Estimate physical SLOC for Cobol and RPG */
IF COND(&PSLOC *EQ '*YES') THEN(DO)
SELECT
WHEN COND((%SCAN('CBL' &MBRINFO_MBSEU2) *GT +
0) *OR (%SCAN('CBL' &PSTMFEXT) *GT +
0)) THEN(DO)
CHGVAR VAR(&SQL) VALUE('UPDATE QTEMP/SLOC +
SET NUMBER = (SELECT COUNT(*) +
FROM +
TABLE(QSYS2.IFS_READ(PATH_NAME => +
''' *CAT &STMF *TCAT ''', +
END_OF_LINE => ''' *CAT +
%SST(&PENDLINFMT 2 5) *TCAT ''')) +
WHERE LINE LIKE ''_%'' AND NOT +
REGEXP_LIKE(LINE, ''^.{6}\*.*'') +
AND NOT REGEXP_LIKE(LINE, +
''^.{6}\s.*process\s.*'', ''i''))')
CHGVAR VAR(&SLOC) VALUE('1')
ENDDO /* COND((%SCAN('CBL' &MBRINFO_MBSEU2) +
*LE 0) *OR (%SCAN('CBL' &PSTMFEXT) +
*LE 0)) */
WHEN COND((%SCAN('RPG' &MBRINFO_MBSEU2) *GT +
0) *OR (%SCAN('RPG' &PSTMFEXT) *GT +
0)) THEN(DO)
CHGVAR VAR(&SQL) VALUE('UPDATE QTEMP/SLOC +
SET NUMBER = (SELECT COUNT(*) +
FROM +
TABLE(QSYS2.IFS_READ(PATH_NAME => +
''' *CAT &STMF *TCAT ''', +
END_OF_LINE => ''' *CAT +
%SST(&PENDLINFMT 2 5) *TCAT ''')) +
WHERE LINE LIKE ''_%'' AND NOT +
REGEXP_LIKE(LINE, ''^\*\*free'', +
''i'') AND NOT REGEXP_LIKE(LINE, +
''^\s*ctl-opt\s.*'', ''i'') AND +
NOT REGEXP_LIKE(LINE, +
''^\s*\/\/(.)*'') AND NOT +
REGEXP_LIKE(LINE, +
''^\s*\/[a-zA-Z]'', ''i'') AND +
NOT REGEXP_LIKE(LINE, +
''^.{6}\*((?!\;).)*$''))')
CHGVAR VAR(&SLOC) VALUE('1')
ENDDO /* COND((%SCAN('RPG' &MBRINFO_MBSEU2) +
*GT 0) *OR (%SCAN('RPG' &PSTMFEXT) +
*GT 0)) */
OTHERWISE CMD(DO)
CHGVAR VAR(&SLOC) VALUE('0')
ENDDO /* OTHERWISE */
ENDSELECT
IF COND(&SLOC) THEN(DO)
RUNSQL SQL(&SQL) COMMIT(*NONE)
RCVF OPNID(SLOC)
CLOSE OPNID(SLOC) /* RCVF */
CHGVAR VAR(&SQL) VALUE('INSERT INTO +
QTEMP.REPORT VALUES(''"' *CAT +
&FROMLIB *TCAT '";"' *CAT &FROMFILE +
*TCAT '";"' *CAT &MBRINFO_MBNAME +
*TCAT '";"' *CAT &MBRINFO_MBSEU2 +
*TCAT '";"' *CAT &TEXTOUT *TCAT +
'";"' *CAT %CHAR(&MBRINFO_MBNRCD) +
*TCAT '";"' *CAT %CHAR(&SLOC_NUMBER) +
*TCAT '";"' *CAT &MBRCRTTS *TCAT +
'";"' *CAT &MBRCHGTS *TCAT '";"' +
*CAT %CHAR(&STATOBJSIZ) *TCAT '";"' +
*CAT %CHAR(&STATALCSIZ) *TCAT '"'')')
ENDDO /* COND(&SLOC) */
ELSE CMD(DO)
CHGVAR VAR(&SLOC_NUMBER) VALUE(0)
CHGVAR VAR(&SQL) VALUE('INSERT INTO +
QTEMP.REPORT VALUES(''"' *CAT +
&FROMLIB *TCAT '";"' *CAT &FROMFILE +
*TCAT '";"' *CAT &MBRINFO_MBNAME +
*TCAT '";"' *CAT &MBRINFO_MBSEU2 +
*TCAT '";"' *CAT &TEXTOUT *TCAT +
'";"' *CAT %CHAR(&MBRINFO_MBNRCD) +
*TCAT '";" ";"' *CAT &MBRCRTTS *TCAT +
'";"' *CAT &MBRCHGTS *TCAT '";"' +
*CAT %CHAR(&STATOBJSIZ) *TCAT '";"' +
*CAT %CHAR(&STATALCSIZ) *TCAT '"'')')
ENDDO /* COND(*NOT &SLOC) */
CHGVAR VAR(&SLOCCNT) VALUE(&SLOCCNT + &SLOC_NUMBER)
ENDDO /* COND(&PSLOC *EQ '*YES') */
ELSE CMD(DO)
CHGVAR VAR(&SQL) VALUE('INSERT INTO QTEMP.REPORT +
VALUES(''"' *CAT &FROMLIB *TCAT '";"' +
*CAT &FROMFILE *TCAT '";"' *CAT +
&MBRINFO_MBNAME *TCAT '";"' *CAT +
&MBRINFO_MBSEU2 *TCAT '";"' *CAT +
&TEXTOUT *TCAT '";"' *CAT +
%CHAR(&MBRINFO_MBNRCD) *TCAT '";"' *CAT +
&MBRCRTTS *TCAT '";"' *CAT &MBRCHGTS +
*TCAT '";"' *CAT %CHAR(&STATOBJSIZ) +
*TCAT '";"' *CAT %CHAR(&STATALCSIZ) +
*TCAT '"'')')
ENDDO /* COND(&PSLOC *NE '*YES') */
RUNSQL SQL(&SQL) COMMIT(*NONE)
ENDDO /* COND(&PREPORT *EQ '*YES') */
ENDDO /* DOWHILE */
/* Display run statistics */
CHGVAR VAR(&SIZEDEC) VALUE(&MBRCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&EDTNUM)
IF COND(&EDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&MBRCNTCHAR) VALUE(&SIZECHAR)
ENDDO /* COND(&EDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&MBRCNTCHAR) VALUE('0')
ENDDO /* COND(&EDTNUM *NE 0) */
CHGVAR VAR(&SIZEDEC) VALUE(&RCDCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&EDTNUM)
IF COND(&EDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&RCDCNTCHAR) VALUE(&SIZECHAR)
ENDDO /* COND(&EDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&RCDCNTCHAR) VALUE('0')
ENDDO /* COND(&EDTNUM *NE 0) */
CHGVAR VAR(&SIZEDEC) VALUE(&IFSSIZ)
CALLSUBR SUBR(EDTNUM) RTNVAL(&EDTNUM)
IF COND(&EDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&IFSSIZCHAR) VALUE(&SIZECHAR)
ENDDO /* COND(&EDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&IFSSIZCHAR) VALUE('0')
ENDDO /* COND(&EDTNUM *NE 0) */
CHGVAR VAR(&SIZEDEC) VALUE(&IFSALC)
CALLSUBR SUBR(EDTNUM) RTNVAL(&EDTNUM)
IF COND(&EDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&IFSALCCHAR) VALUE(&SIZECHAR)
ENDDO /* COND(&EDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&IFSALCCHAR) VALUE('0')
ENDDO /* COND(&EDTNUM *NE 0) */
IF COND(&PSLOC *EQ '*YES') THEN(DO)
CHGVAR VAR(&SIZEDEC) VALUE(&SLOCCNT)
CALLSUBR SUBR(EDTNUM) RTNVAL(&EDTNUM)
IF COND(&EDTNUM *EQ 0) THEN(DO)
CHGVAR VAR(&SLOCCNTCHR) VALUE(&SIZECHAR)
ENDDO /* COND(&EDTNUM *EQ 0) */
ELSE CMD(DO)
CHGVAR VAR(&SLOCCNTCHR) VALUE('0')
ENDDO /* COND(&EDTNUM *NE 0) */
ENDDO /* COND(&PSLOC *EQ '*YES') */
/* Create CSV report */
IF COND(&PREPORT *EQ '*YES') THEN(DO)
IF COND(&PSLOC *EQ '*NO') THEN(DO)
CHGVAR VAR(&SQL) VALUE('INSERT INTO QTEMP.REPORT +
VALUES(''"";"";"' *CAT %CHAR(&MBRCNT) +
*TCAT '";"";"";"' *CAT %CHAR(&RCDCNT) +
*TCAT '";"";"";"' *CAT %CHAR(&IFSSIZ) +
*TCAT '";"' *CAT %CHAR(&IFSALC) *TCAT '"'')')
ENDDO /* COND(&PSLOC *EQ '*NO') */
ELSE CMD(DO)
CHGVAR VAR(&SQL) VALUE('INSERT INTO QTEMP.REPORT +
VALUES(''"";"";"' *CAT %CHAR(&MBRCNT) +
*TCAT '";"";"";"' *CAT %CHAR(&RCDCNT) +
*TCAT '";"' *CAT %CHAR(&SLOCCNT) *TCAT +
'";"";"";"' *CAT %CHAR(&IFSSIZ) *TCAT +
'";"' *CAT %CHAR(&IFSALC) *TCAT '"'')')
ENDDO /* COND(&PSLOC *NE '*NO') */
RUNSQL SQL(&SQL) COMMIT(*NONE)
CPYTOSTMF +
FROMMBR('/QSYS.LIB/QTEMP.LIB/REPORT.FILE/REPORT+
.MBR') TOSTMF(&REPORT) STMFOPT(*REPLACE) +
CVTDTA(*AUTO) DBFCCSID(*FILE) +
STMFCCSID(&PSTMFCCSID) ENDLINFMT(&PENDLINFMT) +
AUT(&PAUT)
DLTF FILE(QTEMP/REPORT)
MONMSG MSGID(CPF0000)
ENDDO /* COND(&PREPORT *EQ '*YES') */
IF COND(&PSLOC *EQ '*NO') THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE('Member processed:' *BCAT +
%TRIML(&MBRCNTCHAR) *BCAT '- Records:' *BCAT +
%TRIML(&RCDCNTCHAR) *BCAT '- IFS size +
(byte):' *BCAT %TRIML(&IFSSIZCHAR) *BCAT '- +
IFS allocated size (byte):' *BCAT +
%TRIML(&IFSALCCHAR))
ENDDO /* COND(&PSLOC *EQ '*NO') */
ELSE CMD(DO)
CHGVAR VAR(&MSGDTA) VALUE('Member processed:' *BCAT +
%TRIML(&MBRCNTCHAR) *BCAT '- Records:' *BCAT +
%TRIML(&RCDCNTCHAR) *BCAT '- Cobol SLOC:' +
*BCAT %TRIML(&SLOCCNTCHR) *BCAT '- IFS size +
(byte):' *BCAT %TRIML(&IFSSIZCHAR) *BCAT '- +
IFS allocated size (byte):' *BCAT +
%TRIML(&IFSALCCHAR))
ENDDO /* COND(&PSLOC *NE '*NO') */
SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
GOTO CMDLBL(CLEANUP)
ERROR:
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)
CHGVAR VAR(&PGMERROR) VALUE('1')
CLEANUP:
DLTF FILE(QTEMP/MEMBERLIST)
MONMSG MSGID(CPF0000)
CLOSE OPNID(PFSRC) /* RCVF */
MONMSG MSGID(CPF0000)
CLOSE OPNID(SLOC) /* RCVF */
MONMSG MSGID(CPF0000)
CLOSE OPNID(MBRINFO) /* RCVF */
MONMSG MSGID(CPF0000)
DLTOVR FILE(*ALL) LVL(*) /* OVRDBF */
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/PFSRCLIST)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/SLOC)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/MBRLIST)
MONMSG MSGID(CPF0000)
/* Goto exit */
IF COND(&PGMERROR *EQ '0') THEN(DO)
GOTO CMDLBL(RETURN)
ENDDO /* COND(&PGMERROR *EQ '0') */
/* Call error subroutine */
CALLSUBR SUBR(ERROR)
RETURN:
RETURN
/* SUBR(VFYPFSRC): Start *********************************************/
VFYPFSRC: SUBR SUBR(VFYPFSRC)
CHGVAR VAR(&SUBRNAME) VALUE('VFYPFSRC')
CHGVAR VAR(&VFYPFSRC) VALUE(0)
CHGVAR VAR(&QDBFFMTTYP) VALUE('*INT')
CALLSUBR SUBR(RSTAPIERR) RTNVAL(&RSTAPIERR)
CALL PGM(QDBRTVFD) PARM(&FILD0100 &FILD0100L +
&QDBFOUT 'FILD0100' &QDBFIN &QDBFRCDFMT +
&QDBFOVR &QDBFSYS &QDBFFMTTYP &APIERROR)
IF COND(&AEBYTAVL *NE 0) THEN(DO)
SNDPGMMSG MSGID(&AEEXCPID) MSGF(QCPFMSG) +
MSGDTA(&AEEXCPDTA) TOPGMQ(*SAME (*)) +
TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
CHGVAR VAR(&APINAME) VALUE('QDBRTVFD')
CHGVAR VAR(&ERRORTEXT) VALUE(' (API' *BCAT &APINAME +
*BCAT 'in' *BCAT &SUBRNAME *TCAT ')')
CHGVAR VAR(&VFYPFSRC) VALUE(-1)
ENDDO /* COND(&AEBYTAVL *NE 0) */
ELSE CMD(DO)
/* Test type of file: On -> LF, Off -> PF */
CHGVAR VAR(&BIT_POS) VALUE(2)
CALLPRC PRC('_TSTBTS') PARM((&QDBFHFLG) (&BIT_POS +
*BYVAL)) RTNVAL(&BIT_POS)
CHGVAR VAR(&BIT_2_ON) VALUE(&BIT_POS *EQ 1)
/* Test FILETYPE: On -> SRC, Off -> DTA */
CHGVAR VAR(&BIT_POS) VALUE(4)
CALLPRC PRC('_TSTBTS') PARM((&QDBFHFLG) (&BIT_POS +
*BYVAL)) RTNVAL(&BIT_POS)
CHGVAR VAR(&BIT_4_ON) VALUE(&BIT_POS *EQ 1)
IF COND(&BIT_2_ON) THEN(DO)
CHGVAR VAR(&FILEATRB) VALUE('LF')
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&FILEATRB) VALUE('PF')
ENDDO
IF COND(&BIT_4_ON) THEN(DO)
CHGVAR VAR(&FILETYPE) VALUE('SRC')
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&FILETYPE) VALUE('DTA')
ENDDO
CHGVAR VAR(&NBRALLMBR) VALUE(&QDBFHMNUM)
CHGVAR VAR(&VFYPFSRC) VALUE(0)
ENDDO /* COND(&AEBYTAVL *EQ 0) */
ENDSUBR RTNVAL(&VFYPFSRC)
/* SUBR(VFYPFSRC): End ***********************************************/
/* SUBR(DUPQUOTE): Start *********************************************/
DUPQUOTE: SUBR SUBR(DUPQUOTE)
CHGVAR VAR(&SUBRNAME) VALUE('DUPQUOTE')
CHGVAR VAR(&DUPQUOTE) VALUE(0)
CHGVAR VAR(&TEXTOUT) VALUE(' ')
CHGVAR VAR(&TEXT_J) VALUE(1)
DOFOR VAR(&TEXT_I) FROM(1) TO(%SIZE(&TEXTIN))
IF COND(%SST(&TEXTIN &TEXT_I 1) *NE "E) THEN(DO)
CHGVAR VAR(%SST(&TEXTOUT &TEXT_J 1)) +
VALUE(%SST(&TEXTIN &TEXT_I 1))
CHGVAR VAR(&TEXT_J) VALUE(&TEXT_J + 1)
ENDDO /* COND(%SST(&TEXTIN &TEXT_I 1) *NE "E) */
ELSE CMD(DO)
CHGVAR VAR(%SST(&TEXTOUT &TEXT_J 2)) +
VALUE("E *CAT "E *CAT "E +
*CAT "E)
CHGVAR VAR(&TEXT_J) VALUE(&TEXT_J + 2)
ENDDO /* COND(%SST(&TEXTIN &TEXT_I 1) *EQ "E) */
IF COND(&TEXT_J *GT %SIZE(&TEXTOUT)) THEN(DO)
LEAVE
ENDDO /* COND(&TEXT_J *GT %SIZE(&TEXTOUT)) */
ENDDO /* DOFOR */
ENDSUBR RTNVAL(&DUPQUOTE)
/* SUBR(DUPQUOTE): End ***********************************************/
/* SUBR(EDTNUM): Start ***********************************************/
EDTNUM: SUBR SUBR(EDTNUM)
CHGVAR VAR(&SUBRNAME) VALUE('EDTNUM')
CHGVAR VAR(&EDTNUM) VALUE(0)
CHGVAR VAR(%BIN(&SRCVARPCSN)) VALUE(15)
CHGVAR VAR(%BIN(&SRCVARDEC)) VALUE(0)
CALL PGM(QECCVTEC) PARM(&EDTMASK &EDTMASKLEN +
&RCVVARLEN &ZROBAL &EDTCODE &CURRENCY +
&SRCVARPCSN &SRCVARDEC &APIERROR)
CALL PGM(QECEDT) PARM(&SIZECHAR &RCVVARLEN &SIZEDEC +
'*PACKED' &SRCVARPCSN &EDTMASK &EDTMASKLEN +
&ZROBAL &APIERROR)
ENDSUBR RTNVAL(&EDTNUM)
/* SUBR(EDTNUM): End *************************************************/
/* SUBR(RSTAPIERR): Start ********************************************/
RSTAPIERR: SUBR SUBR(RSTAPIERR)
CHGVAR VAR(&SUBRNAME) VALUE('RSTAPIERR')
CHGVAR VAR(&RSTAPIERR) VALUE(0)
CHGVAR VAR(&AEBYTPRO) VALUE(0)
CHGVAR VAR(&AEBYTAVL) VALUE(0)
ENDSUBR RTNVAL(&RSTAPIERR)
/* SUBR(RSTAPIERR): End **********************************************/
/* SUBR(ERROR): Start ************************************************/
ERROR: SUBR SUBR(ERROR)
CHGVAR VAR(&SUBRNAME) VALUE('ERROR')
IF COND(&ERROR) THEN(RETURN)
CHGVAR VAR(&ERROR) VALUE('1')
/* 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)
/* Send DIAGNOSTIC message */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV (*)) +
TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)
MONMSG MSGID(CPF0000)
ENDDO /* COND((&RTNTYPE *EQ '02') *OR (&RTNTYPE *EQ +
'15') *OR (&RTNTYPE *EQ '17')) */
/* Send ESCAPE message */
IF COND(&PGMERROR) THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE(&PGMNAME *BCAT 'ended +
abnormally' *CAT %TRIMR(&ERRORTEXT))
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
TOPGMQ(*PRV (*)) TOMSGQ(*TOPGMQ) +
MSGTYPE(*ESCAPE)
ENDDO /* COND(&PGMERROR) */
ENDSUBR RTNVAL(0)
/* SUBR(ERROR): End **************************************************/
ENDPGM:
ENDPGMRiferimenti:
Copy To Stream File (CPYTOSTMF)
Find Source Member (FNDSRCMBR): Subroutine VFY_SRCF (verify source file attributes)
Riceviamo e pubblichiamo ben volentieri questo "tip & trick" di Patrick Rizzi che presenta una tecnica che permette di intervenire…
Prendo spunto da una risposta di Michael Mayer sulle mailing list di Midrange.com a chi chiedeva come monitorare i messaggi…
Le imprese sono sempre più alla ricerca di strumenti che possano migliorare l'efficienza, la collaborazione e la gestione delle risorse.…
I primi di Aprile è uscita la "Spring Version" di ACS Access Client Solution, versione 1.1.9.5 Interessanti novità soprattutto in…
Se non vi bastava la ricca agenda delle sessioni del Common Europe Congress 2024, 3-6 Giugno Milano, ecco un altro…
Le funzioni di debug con Visual Studio Code sono disponibili da qualche tempo ma questa nuova versione 2.10.0 semplifica la…
View Comments
Ottimo lavoro. Stavo utilizzando il tool in questi giorni. Ho notato che quando si specifica nel parametro MBR un nome di membro specifico (senza usare *) il membro non viene copiato.
Suggerisco questa modifica al programma CLLE CPYSRC2IFC nella sezione identificata dal commento /* Extract members to be processed */ al fine di ottenere un'istruzione SQL con un filtro di selezione (clausola where) diversa in base al contenuto del parametro MBR (con o senza carattere jolly *)
IF COND(%SCAN('*' &PMBR) *NE 0) THEN(DO)
CHGVAR VAR(&SQL) VALUE('CREATE TABLE QTEMP.MBRLIST AS (SELECT +
MBNAME, MBSEU2, MBMTXT, MBNRCD, MBCCEN, MBCDAT, MBCTIM, +
MBUPDC, MBUPDD, MBUPDT FROM QTEMP.MEMBERLIST WHERE MBNAME +
NOT LIKE '' %'' AND MBNAME LIKE REPLACE(''' *CAT &PMBR +
*TCAT ''', ''*'', ''%'') ORDER BY MBNAME) WITH DATA')
ENDDO
ELSE DO
CHGVAR VAR(&SQL) VALUE('CREATE TABLE QTEMP.MBRLIST AS (SELECT +
MBNAME, MBSEU2, MBMTXT, MBNRCD, MBCCEN, MBCDAT, MBCTIM, +
MBUPDC, MBUPDD, MBUPDT FROM QTEMP.MEMBERLIST WHERE MBNAME = +
''' *CAT &PMBR *TCAT ''' ORDER BY MBNAME) WITH DATA')
ENDDO