12/10/08 How to create a self-submitting CL program

Have you ever written a program that you did not want someone to be able to run interactively? The following code example can be used to create a CL program that will get submitted to batch even if it is called from a command line.

Note: The following is limited to programs with no parameters, but with some modification specific to the program, it can be made to process a program that has parameters.


PGM
/*********************************************************************/
/* Declare the program's file being used */
/*********************************************************************/
DCLF FILE(QADSPOBJ)

/*********************************************************************/
/* Declare program variables */
/*********************************************************************/
DCL &DEVICE *CHAR LEN(10) /* The job name running this pgm */
DCL &USER *CHAR LEN(10) /* The user running this pgm */
DCL &NBR *CHAR LEN(6) /* This job number */
DCL &TYPE *CHAR LEN(1) /* This job type */
DCL &MSGKEY *CHAR LEN(4) /* Message key for sbmjob routine*/
DCL &SENDER *CHAR LEN(80) /* The sender of a message */
DCL &PROGRAM *CHAR LEN(10) /* Program that sent a message */
DCL &CMD *CHAR LEN(1024) /* Cmd for QCMDEXC */
DCL &CMDLEN *DEC LEN(15 5) /* Length of command */
/*********************************************************************/
/* Declare standard error handling variables */
/*********************************************************************/
DCL &ERRORSW *LGL /* Standard error */
DCL &MSGID *CHAR LEN(7) /* Standard error */
DCL &MSG *CHAR LEN(512) /* Standard error */
DCL &MSGDTA *CHAR LEN(512) /* Standard error */
DCL &MSGF *CHAR LEN(10) /* Standard error */
DCL &MSGFLIB *CHAR LEN(10) /* Standard error */
DCL &KEYVAR *CHAR LEN(4) /* Standard error */
DCL &KEYVAR2 *CHAR LEN(4) /* Standard error */
DCL &RTNTYPE *CHAR LEN(2) /* Standard error */

/*********************************************************************/
/* Monitor for the global error to handle errors that are not */
/* specifically checked */
/*********************************************************************/
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1) /* Std err */

RTVJOBA JOB(&DEVICE) USER(&USER) NBR(&NBR) TYPE(&TYPE)
CHGVAR &CMDLEN VALUE(1024.0)
CHGVAR &CMD VALUE(' ')

/*********************************************************************/
/* If this program is called interactively submit it to batch */
/*********************************************************************/
IF (&TYPE = '1') THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) TOPGMQ(*SAME) +
KEYVAR(&MSGKEY)
RCVMSG MSGTYPE(*INFO) MSGKEY(&MSGKEY) WAIT(*MAX) +
SENDER(&SENDER)
CHGVAR VAR(&PROGRAM) VALUE(%SST(&SENDER 27 10))
SBMJOB CMD(CALL PGM(&PROGRAM)) +
JOB(&PROGRAM) LOG(4 00 *SECLVL)
RCVMSG MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*COMP)
RETURN
ENDDO

/*********************************************************************/
/* Insert program code here */
/*********************************************************************/



END:
RETURN

/*********************************************************************/
/* Process the standard error handling routines */
/*********************************************************************/
STDERR1:
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
CHGVAR &ERRORSW '1' /* Set to fail on error */
RCVMSG MSGTYPE(*EXCP) RMV(*NO) KEYVAR(&KEYVAR)
STDERR2: RCVMSG MSGTYPE(*PRV) MSGKEY(&KEYVAR) RMV(*NO) +
KEYVAR(&KEYVAR2) MSG(&MSG) +
MSGDTA(&MSGDTA) MSGID(&MSGID) +
RTNTYPE(&RTNTYPE) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
IF (&RTNTYPE *NE '02') GOTO STDERR3
IF (&MSGID *NE ' ') SNDPGMMSG +
MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
IF (&MSGID *EQ ' ') SNDPGMMSG +
MSG(&MSG) MSGTYPE(*DIAG)
RMVMSG MSGKEY(&KEYVAR2)
STDERR3: RCVMSG MSGKEY(&KEYVAR) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM

Disclaimer: Vision Solutions makes every effort to provide accurate system management information and programming code; however the company cannot be held liable for the accuracy of information nor its compatibility in your own environment. Please review and test thoroughly before implementing. © Copyright 2008, Vision Solutions, Inc. All rights reserved. IBM, System i, iSeries, i5/OS and AS/400 are trademarks of International Business Machines Corporation. All other brands are property of their respective registered owners.