The Check Object (CHKOBJ) command gives CL programs the ability to check whether a given object exists. You can specify the object type, so it's not difficult to find out if a file exists. You can even specify a member; in that case, CHKOBJ verifies that the member exists, too.
But that's as far as CHKOBJ goes. If you want to know whether an existing file is a source file, CHKOBJ won't do: You need the Retrieve Member Description (RTVMBRD) command. RTVMBRD has two parameters to help you in that case: File Attribute (FILEATR) and File Type (FILETYPE). For source files, FILEATR must be *PF and FILETYPE must be *SRC.
The problem with RTVMBRD, however, is that it cannot work if the file being tested has no members. This state of affairs has always bothered me, so I created my own source file checking command, Is Source File (ISSRCF), which you can see in Figure 4. Figure 5 shows the accompanying CL program, SRC015CL.
ISSRCF receives a qualified file name in its SRCF parameter and returns a single character in the ANSWER parameter. When you code ISSRCF in a CL program, you must use a 1-byte character variable in the ANSWER parameter. When ISSRCF ends, the variable will contain one of the following values:
o Y (yes), if the file is a source physical file
o N (no), if the file is a database file but not a source file (e.g., a logical file or a nonsource physical)
o U (unknown), if the file is locked by another job, damaged, inaccessible for lack of authority, or unable to be checked for any other reason
o E (error), if the file or library does not exist or if ISSRCF ends in error for any other reason
- Ernie Malaga
Figure 4: The ISSRCF command will tell you if a file is a source file.
/*===================================================================*/
/* To compile: */
/* */
/* CRTCMD CMD(XXX/ISSRCF) PGM(XXX/SRC015CL) + */
/* SRCFILE(XXX/QCMDSRC) TEXT('Is Source + */
/* File?') ALLOW(*IPGM *IMOD *BPGM *BMOD) */
/* */
/*===================================================================*/
CMD PROMPT('Is Source File?')
PARM KWD(SRCF) TYPE(Q1) MIN(1) PROMPT('Source file')
Q1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) +
PROMPT('Library')
PARM KWD(ANSWER) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
CHOICE('Y=Yes, N=No, E=Error, U=Unkn') +
PROMPT('Answer A(1)') /*===================================================================*/
/* To compile: */
/* */
/* CRTCLPGM PGM(XXX/SRC015CL) SRCFILE(XXX/QCLSRC) + */
/* TEXT('CPP for ISSRCF command') */
/* */
/*===================================================================*/
PGM PARM(&Q_SRCF &ANSWER)
DCL VAR(&ANSWER) TYPE(*CHAR) LEN(1)
DCL VAR(&DUMMYADD) TYPE(*LGL) LEN(1)
DCL VAR(&ERROR) TYPE(*CHAR) LEN(1) VALUE('E')
DCL VAR(&FALSE) TYPE(*LGL) LEN(1) VALUE('0')
DCL VAR(&FILEATR) TYPE(*CHAR) LEN(3)
DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5)
DCL VAR(&NO) TYPE(*CHAR) LEN(1) VALUE('N')
DCL VAR(&Q_SRCF) TYPE(*CHAR) LEN(20)
DCL VAR(&SRCF) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TRUE) TYPE(*LGL) LEN(1) VALUE('1')
DCL VAR(&UNKNOWN) TYPE(*CHAR) LEN(1) VALUE('U')
DCL VAR(&YES) TYPE(*CHAR) LEN(1) VALUE('Y')
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))
/* Break qualified name */
CHGVAR VAR(&SRCF) VALUE(%SST(&Q_SRCF 1 10))
CHGVAR VAR(&SRCFLIB) VALUE(%SST(&Q_SRCF 11 10))
/* Check existence of file */
CHGVAR VAR(&ANSWER) VALUE(&YES)
CHKOBJ OBJ(&SRCFLIB/&SRCF) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801 CPF9810) EXEC(DO)
/* Can't find file or library */
CHGVAR VAR(&ANSWER) VALUE(&ERROR)
GOTO CMDLBL(END_EXEC)
ENDDO
MONMSG MSGID(CPF9800) EXEC(DO)
/* Other errors */
CHGVAR VAR(&ANSWER) VALUE(&UNKNOWN)
GOTO CMDLBL(END_EXEC)
ENDDO
/* Is it a source file? */
CHGVAR VAR(&DUMMYADD) VALUE(&FALSE)
CHECK:
RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(*FIRST) +
Figure 5: CL program SRC015CL
FILEATR(&FILEATR) FILETYPE(&FILETYPE)
MONMSG MSGID(CPF3019) EXEC(DO)
/* No members: Add dummy */
CHGVAR VAR(&DUMMYADD) VALUE(&TRUE)
ADDPFM FILE(&SRCFLIB/&SRCF) MBR(DUMMY)
GOTO CMDLBL(CHECK)
ENDDO
MONMSG MSGID(CPF3018 CPF3051 CPF327B CPF8109 +
CPF8110 CPF8111 CPF9803 CPF9806 CPF9820 +
CPF9822) EXEC(DO)
/* Can't determine answer */
CHGVAR VAR(&ANSWER) VALUE(&UNKNOWN)
GOTO CMDLBL(END_EXEC)
ENDDO
MONMSG MSGID(CPF3027) EXEC(DO)
/* Not a database file */
CHGVAR VAR(&ANSWER) VALUE(&NO)
GOTO CMDLBL(END_EXEC)
ENDDO
MONMSG MSGID(CPF0000) EXEC(DO)
/* Other RTVMBRD errors */
CHGVAR VAR(&ANSWER) VALUE(&ERROR)
GOTO CMDLBL(END_EXEC)
ENDDO
IF COND(&FILEATR *EQ '*PF' *AND &FILETYPE *EQ +
'*SRC') THEN(DO)
CHGVAR VAR(&ANSWER) VALUE(&YES)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&ANSWER) VALUE(&NO)
ENDDO
/* Remove dummy member if added */
END_EXEC:
IF COND(&DUMMYADD) THEN(DO)
RMVM FILE(&SRCFLIB/&SRCF) MBR(DUMMY)
MONMSG MSGID(CPF0000)
ENDDO
/* Remove any existing program messages */
RMVMSG PGMQ(*SAME (*)) CLEAR(*ALL)
MONMSG MSGID(CPF0000)
RETURN
/* Remove dummy member if added */
ERROR:
IF COND(&DUMMYADD) THEN(DO)
RMVM FILE(&SRCFLIB/&SRCF) MBR(DUMMY)
MONMSG MSGID(CPF0000)
ENDDO
/* Forward error messages to caller */
FWDPGMMSG
MONMSG MSGID(CPF0000)
ENDPGM
LATEST COMMENTS
MC Press Online