Sample CL Program Template
Get ready for an early morning ramble about a slew of Control Language stuff.
In my defense, my brain is a pasta bowl of ideas early in the morning and needs several cups of tea to calm it down into any semblance of structure. 😉
I very nearly deleted this video rather than upload it, but then decided it might be good for newbie CL programmers to watch me jumping around covering things like:
So, dive into 20 minutes of pre-waffle getting us to the point of looking at the CL Template itself
Here is the Control Language Source Code in all it's glory.
Cut and paste this into your IDE (VSCODE or RDi) to use it:
/* TEMPLATE - This is a template for a simple CL program */
/* Program.......... TEMPLATE */
/* Author........... nick@nicklitten.com */
/* Calling Program.. *NONE */
/* Calling Command.. *NONE */
/* User Profile..... *USER */
/* Object Owner..... QPGMR */
/* Compiler Options. This is a CLLE *MODULE bound into *PGM */
/* Module: CRTCLMOD MODULE('library'/TEMPLATE) */
/* SRCFILE('library'/QCLLESRC) */
/* SRCMBR(TEMPLATE) */
/* OPTIMIZE(*NONE) */
/* DBGVIEW(*SOURCE) */
/* ILEPGM: CRTPGM PGM('library'/TEMPLATE) MODULE(TEMPLATE*) */
/* ----------------------------------------------------------*/
/* Modification History: */
/* Author Date Description */
/* NJL01 10/17/2017 Created */
/* NJL02 10/01/2024 Minor Code Tidyup and comment refresh */
/* --------------------------------------------------------- */
PGM
DCLPRCOPT LOG(*NO) DFTACTGRP(*NO) ACTGRP(*CALLER)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&CRASHED) TYPE(*LGL) VALUE('0')
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
DCL VAR(&MSGFIL) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
/* NOTE: the COPYRIGHT statement will display when you do a DSPPGM but we +
can go an extra step and include it with a variable so that it +
displays in DUMP outputs... not that my code ever dumps of course 😉 */
COPYRIGHT TEXT('TEMPLATE Ver:001 Simple CL template. Add any comments you like here')
DCL VAR(©RIGHT) TYPE(*CHAR) LEN(256) +
VALUE('YOUR COMPANY © 2024 | IBM i V7.5 https://www.nicklitten.com')
/* &VARIABLES are not shown in DUMPS unless they are used but we can *fool* IBM i +
into using it - how about something like a little pointer? */
DCL VAR(©RIGHTP) TYPE(*PTR) STG(*DEFINED) DEFVAR(©RIGHT)
/* Global monitor for any error messages */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(CRASH))
/* a little initialization subroutine to do pre-run gubbins */
CALLSUBR SUBR(INZSR)
/* begin regular program logic here */
CALLSUBR SUBR(MAINLINE)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Program' *BCAT &PGMNAME *BCAT 'completed normally') MSGTYPE(*COMP)
END: RETURN
CRASH: CALLSUBR SUBR(CRASH)
/* -------------------------------------------------------- */
/* SUBROUTINE SECTION */
/* Initialization Routine - lets use it to get the pgm name */
/* -------------------------------------------------------- */
SUBR SUBR(INZSR)
SNDPGMMSG MSG('What is this program name?') TOPGMQ(*SAME) MSGTYPE(*INFO) KEYVAR(&MSGKEY)
CHGVAR VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
ENDSUBR
/* ------------------------------------------------ */
/* MAINLINE - You could use this for your mainline */
/* ------------------------------------------------ */
SUBR SUBR(MAINLINE)
/* This is where all your main code will go */
/* if any error occurs the global MONMSG will pick it up and spit +
us into the error handling subroutine */
CHKOBJ OBJ(QTEMP/SANTACLAUS) OBJTYPE(*PGM)
/* Here is an example command that will deliberately crash, forcing +
a program ABEND so you can see the error message in use. Obviously +
you should replace this with the actual logic you are writing... */
RTNSUBR
ENDSUBR
/* ------------------------------------------------------------ */
/* CRASH : Routine to handle unexpected errors */
/* ------------------------------------------------------------ */
SUBR SUBR(CRASH)
IF COND(&CRASHED) THEN(RETURN)
CHGVAR VAR(&CRASHED) VALUE('1')
/* This subroutine will read back through this programs joblog */
/* and pump out messages to your joblog based on the status */
/* codes returned from RCVMSG. RTNTYPE values include: */
/* - 01 Completion */
/* - 02 Diagnostic */
/* - 04 Information */
/* - 05 Inquiry */
/* - 06 Copy */
/* - 08 Request */
/* - 10 Request with prompting */
/* - 14 Notify (exception already handled at time of RCVMSG) */
/* - 15 Escape (exception already handled at time of RCVMSG) */
/* - 16 Notify (exception not handled at time of RCVMSG) */
/* - 17 Escape (exception not handled at time of RCVMSG) */
/* - 21 Reply, not checked for validity */
/* - 22 Reply, already checked for validity */
/* - 23 Reply, message default used */
/* - 24 Reply, system default used */
/* - 25 Reply, from System Reply List */
/* - 26 Reply, from exit program */
RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) +
RTNTYPE(&RTNTYPE) MSGF(&MSGFIL) SNDMSGFLIB(&MSGFLIB)
IF COND(&RTNTYPE *EQ '15' *OR &RTNTYPE *EQ '17') THEN(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFIL) MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
ENDDO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('* Program' *BCAT &PGMNAME *BCAT 'ended abnormally') +
MSGTYPE(*ESCAPE)
ENDSUBR