/**********************************************************/
/* */
/* Program: OBJEXISTS */
/* Purpose: Test object existence using path name */
/* Notes: This is the CPP for the OBJEXISTS command. */
/* The first parameter is the full path name */
/* of an object, the second is a logical status */
/* code - TRUE means object exists. */
/* */
/**********************************************************/
PGM PARM(&PATHNAME &RETURN)
/* Parameters */
DCL VAR(&PATHNAME) TYPE(*CHAR) LEN(514)
DCL VAR(&RETURN) TYPE(*LGL)
/* Constants */
DCL VAR(&TRUE) TYPE(*LGL) VALUE('1')
DCL VAR(&FALSE) TYPE(*LGL) VALUE('0')
DCL VAR(&EXISTS) TYPE(*DEC) LEN(1 0) VALUE(0) /* +
0 -> file exists */
/* API parameters and return value */
DCL VAR(&PATHLEN) TYPE(*DEC) LEN(3 0)
DCL VAR(&PATHNULTRM) TYPE(*CHAR) LEN(513) /* +
Extra character needed for null +
termination */
DCL VAR(&MODE) TYPE(*CHAR) LEN(4) /* API define +
F_OK = 0 (integer) */
DCL VAR(&RTNVAL) TYPE(*CHAR) LEN(4) /* 0 -> file +
exists; -1 -> file does not exist */
/* Append null to end of path name */
CHGVAR VAR(&PATHNULTRM) VALUE(%SST(&PATHNAME 3 512))
CHGVAR VAR(&PATHLEN) VALUE(%BIN(&PATHNAME 1 2) + 1)
CHGVAR VAR(%SST(&PATHNULTRM &PATHLEN 1)) VALUE(X'00')
/* Set access mode to file existence - F_OK */
CHGVAR VAR(%BIN(&MODE)) VALUE(0)
/* Call API - %BIN() on RTNVAL indicates */
/* integer value shall be returned */
CALLPRC PRC('access') PARM(&PATHNULTRM &MODE) +
RTNVAL(%BIN(&RTNVAL))
/* Set logical value to result of comparison */
CHGVAR VAR(&RETURN) VALUE(%BIN(&RTNVAL) = &EXISTS)
ENDPGM