CHGAUTDRAW

This CL program runs as a background task on our iSeries monitoring for new streamfiles created by a specific user in a specific IFS directory. As new files show up it changes the authority on them. Note that the two commands MOVDIAGMSG and RSNESCMSG are from Tom Liotta's excellent Sharea site

Note that when using RTVJRNE with QSYS objects the object name is found in the RTNJRNE parm value at position 2-11 (%SST(&RTNJRNE 2 10)), and the library in 12-21 (%SST(&RTNJRNE 12 10))

PGM
  DCL        VAR(&DTQLEN) TYPE(*DEC) LEN(5 0) VALUE(6)
  DCL        VAR(&DTQDTA) TYPE(*CHAR) LEN(6)
  DCL        VAR(&DTQWAIT) TYPE(*DEC) LEN(5 0) VALUE(300)
  DCL        VAR(&DTQNOWAIT) TYPE(*DEC) LEN(5 0) VALUE(0)
  DCL        VAR(&OBJ) TYPE(*CHAR) LEN(86)
  DCL        VAR(&TESTOBJ) TYPE(*CHAR) LEN(12)
  DCL        VAR(&RTNJRNE) TYPE(*CHAR) LEN(1000)
  DCL        VAR(&FTPDRAWSEQ) TYPE(*DEC) LEN(10 0)
  DCL        VAR(&FROMENT) TYPE(*DEC) LEN(10 0)
  DCL        VAR(&RTNSEQNBR) TYPE(*DEC) LEN(10 0)
/* ***************************************************************** */
/*  GLOBAL MESSAGE MONITOR                                           */
/* ***************************************************************** */
  MONMSG     MSGID(CPF0000 RPG0000 QRG0000 RSF0000 +
               MCH0000) EXEC(GOTO CMDLBL(##ERROR))
  GOTO       CMDLBL(##NOERROR)
##ERROR:
  MOVDIAGMSG
  MONMSG     MSGID(CPF0000)
  RSNESCMSG
  MONMSG     MSGID(CPF0000)
RETURN
##NOERROR:
/* ***************************************************************** */
/*  START OF MAINLINE CODE                                           */
/* ***************************************************************** */
/* Get the last journal entry processed */
  RTVDTAARA  DTAARA(FTPDRAWSEQ) RTNVAR(&FTPDRAWSEQ)
  CHGVAR     VAR(&FROMENT) VALUE(&FTPDRAWSEQ + 1)
LOOPTOP:
/* Pull back the next Created Object entry for the FTPDRAWING user */
  RTVJRNE    JRN(QAUDJRN) RCVRNG(*CURCHAIN) +
               FROMENT(&FROMENT) ENTTYP(CO) +
               USRPRF(FTPDRAWING) RTNSEQNBR(&RTNSEQNBR) +
               RTNJRNE(&RTNJRNE)
/* Drop into the wait loop if a recognised error found */
/* CPF7073=No entry received, CPF9803=Cannot allocate object */
  MONMSG     MSGID(CPF7073 CPF9803) EXEC(GOTO CMDLBL(WAIT))
  CHGVAR     VAR(&TESTOBJ) VALUE(%SST(&RTNJRNE 925 12))
/* If this is a folder/stmf entry under /moorespc/CentralStore */
  IF         COND(&TESTOBJ *EQ 'CentralStore') THEN(DO)
    CHGVAR     VAR(&OBJ) VALUE(%SST(&RTNJRNE 915 86))
/* Set authority */
    CHGAUT     OBJ(&OBJ) AUTL(CENTRAL)
    MONMSG     MSGID(CPF0000)
    CHGAUT     OBJ(&OBJ) USER(*PUBLIC) DTAAUT(*AUTL) +
                 OBJAUT(*NONE)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Update last entry processed */
  CHGDTAARA  DTAARA(FTPDRAWSEQ) VALUE(&RTNSEQNBR)
/* Check for shutdown request (no waiting) */
  CALL       PGM(QRCVDTAQ) PARM('CFTPDRW01Q' '*LIBL     ' +
               &DTQLEN &DTQDTA &DTQNOWAIT)
/* If flag set to leave... */
  IF         COND(&DTQDTA *EQ 'CANCEL') THEN(GOTO +
                          CMDLBL(ENDPGM))
/* Bump up sequence number for next try */
  CHGVAR     VAR(&FROMENT) VALUE(&RTNSEQNBR + 1)
  GOTO       CMDLBL(LOOPTOP)
/* Job delay - while waiting for more entries to appear in the journal */
WAIT:
  CALL       PGM(QRCVDTAQ) PARM('CFTPDRW01Q' '*LIBL     ' +
               &DTQLEN &DTQDTA &DTQWAIT)
/* If flag set to leave... */
  IF         COND(&DTQDTA *EQ 'CANCEL') THEN(GOTO +
                          CMDLBL(ENDPGM))
/* No escape yet... */
  GOTO       CMDLBL(LOOPTOP)
ENDPGM:
  RETURN
ENDPGM

-- MartinRowe - 27 Dec 2006