Re: CL program to check if folder exists in IFS

Hi Glenn,

I decided not to wait for your reply and to go ahead and modify this the way I think it should be done, because... well.. it's easy for me, and I know it might not be easy for you, so I figured it'd be helpful.

To make it something I could test quick, I defined &SRCLIB and &DIR and made &SRCLIB a parameter... you can of course change that to be however you need it.


PGM PARM(&SRCLIB)

DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&DIR) TYPE(*CHAR) LEN(512)

DCL VAR(&PATHNULTRM) TYPE(*CHAR) LEN(513)
DCL VAR(&MODE) TYPE(*INT) LEN(4)
DCL VAR(&RTNVAL) TYPE(*INT)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')

DCL VAR(&ERRPTR) TYPE(*PTR)
DCL VAR(&ERRNO) TYPE(*INT) STG(*BASED) BASPTR(&ERRPTR)
DCL VAR(&ERRNODEC) TYPE(*DEC) LEN(4 0)

DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGCDE) TYPE(*CHAR) LEN(3) +
STG(*DEFINED) DEFVAR(&MSGID 1)
DCL VAR(&MSGNUM) TYPE(*CHAR) LEN(4) +
STG(*DEFINED) DEFVAR(&MSGID 4)

/* Check if folder for source lib exists. */
/* Call IBM API. */
/* &RTNVAL: 0=file exists, -1=error occurred. */

CHGVAR VAR(&PATHNULTRM) VALUE('/ARCHIVED_SOURCE/' +
*CAT %TRIM(&SRCLIB) *CAT &NULL)

CALLPRC PRC('access') PARM((&PATHNULTRM *BYREF) +
(&MODE *BYVAL)) +
RTNVAL(&RTNVAL)


/* Interpret error. Errno will be CPExxxx where */
/* xxxx is the number returned by the __errno API. */

IF (&RTNVAL = -1) THEN(DO)
CALLPRC PRC('__errno') RTNVAL(&ERRPTR)
CHGVAR VAR(&ERRNODEC) VALUE(&ERRNO)
CHGVAR VAR(&MSGCDE) VALUE('CPE')
CHGVAR VAR(&MSGNUM) VALUE(&ERRNODEC)

/* CPE3025 = no such path or directory */

IF (&MSGID *EQ 'CPE3025') DO
CHGVAR VAR(&DIR) VALUE('/ARCHIVED_SOURCE/' *CAT +
%TRIM(&SRCLIB))
MKDIR DIR(&DIR)
ENDDO
ELSE DO
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
ENDDO
ENDDO

ENDPGM




On 4/7/2015 4:22 PM, Scott Klement wrote:

Glenn,

The access() API works fine for directories.

When you receive a -1, you can call an API called __errno() (that's two
underscores, then 'errno') which returns a pointer. That pointer points
to an integer containing the error number that occurred.

The error number corresponds to a msgid in the QCPFMSG file starting
with 'CPE', so if the error number is '1234', you could look up CPE1234
to find out what the error means.

Taking a quick glance at your code -- it looks wrong to me. The 2nd
parameter (mode) of the access() API must be an integer passed by value.
You are passing a character field by reference. So this probably
won't work.

Are you doing this in order to achieve compatibility with a very old
version of IBM i? (Off the top of my head, the *BYVAL feature was added
in V5R3... but don't quote me on that) If so, you may not be able to
use access() from CL.

But for newer releases, you can just use the *INT data type and the
*BYVAL option whne calling the API.

I could code up an example if you like.



On 4/7/2015 4:12 PM, Glenn Gundermann wrote:

Hi all,

Does the access api work for a folder or does it have to be a file?

I was hoping it works for a folder but the information in the IBM
Knowledge
Center says a file.

If I pass in a folder name that I know exists in the IFS, -1 is returned,
which means failure. Can I debug the access api to see why?

If access is only for files, what is the best way to check if a folder
exists? Use the open api?

Here's the relevant part of the code I am trying.

DCL VAR(&PATHNULTRM) TYPE(*CHAR) LEN(513) /* Allows +
for path of 512 bytes + extra character for null +
termination. */
DCL VAR(&MODE) TYPE(*CHAR) LEN(4)
DCL VAR(&RTNVAL) TYPE(*INT) /* 0=file exists, +
-1=file does not exist */
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')

/* Check if folder for source lib exists. */
/* Call IBM API. */
/* &RTNVAL: 0=file exists, -1=file does not exist. */
CHGVAR VAR(%BIN(&MODE)) VALUE(0) /* Set access mode +
to test if the file exists - F_OK */
CHGVAR VAR(&PATHNULTRM) VALUE('/ARCHIVED_SOURCE/' +
*CAT %TRIM(&SRCLIB) *CAT &NULL)
CALLPRC PRC('access') PARM((&PATHNULTRM) (&MODE)) +
RTNVAL(&RTNVAL)
/* Folder for source lib does not exist so make it. */
IF COND(&RTNVAL = -1) THEN(DO)
CHGVAR VAR(&DIR) VALUE('/ARCHIVED_SOURCE/' *CAT +
%TRIM(&SRCLIB))
MKDIR DIR(&DIR)
ENDDO


Yours truly,

Glenn Gundermann
Email: glenn.gundermann@xxxxxxxxx
Cell: (416) 317-3144