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