.st0{fill:#FFFFFF;}

Sample CLP program template 

 October 17, 2017

By  NickLitten

IBMi Control Language, Templates and Subroutines

Control Language (*CLP) is a wonderful little tool in every IBM i Programmer’s toolkit. Sadly it’s frequently derided, frowned upon and ridiculed by RPG chaps and chappettes. OK, so CL isn’t a full suite business language, but reminds me of learning BBC BASIC back in my school days. I secretly wish I could write everything in CL. It’s simple, and really quite cool.

A fresher IBM programmer was asking me about CL this morning, so I put together this little template for the bare bones of a CL procedure. Of course, there are lots of different ways to structure any piece of code but this is a good starting point.

The basic premise is

  • Barebones CL program with a global capture routine to capture and display errors that we dont explicitly monitor for
  • Some basic variable declarations and copyright options
  • Written in ILE Control Language (CLLE)

So, grab it. Hack it. Have your wicked way with it.

Sample CLP program template

/* ------------------------------------------------------------ */
/* TEMPLATE - automate the HOTFIX distribution and installation */
/* ------------------------------------------------------------ */
/* Program.......... TEMPLATE                                   */
/* Author........... nick@nicklitten.com                        */
/* Calling Program.. *NONE                                      */
/* Calling Command.. *NONE                                      */
/* Function......... This is a template for a simple CL program */
/*                    - edit & use as you please                */
/* 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                                    */
/* ------------------------------------------------------------ */
PGM

RPG Code Snippet IBMi Control Language
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(&COPYRIGHT) TYPE(*CHAR) LEN(256) + VALUE('YOUR COMPANY © 2017 | IBM i V7.1 https://www.nicklitten.com') DCL VAR(&COPYRIGHTP) TYPE(*PTR) STG(*DEFINED) DEFVAR(&COPYRIGHT) /* &VARIABLES are not + shown in DUMPS unless theyre used but we can *fool* IBM i into using it - how + about something like a little pointer? */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(CRASH)) /* Global monitor for any error messages */ CALLSUBR SUBR(INZSR) /* a little initialization subroutine to do pre-run gubbins */ /* begin regular program logic here */ CALLSUBR SUBR(MAINLINE) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Program' *BCAT &PGMNAME *TCAT 'completed normally') MSGTYPE(*COMP) END: RETURN CRASH: CALLSUBR SUBR(CRASH) /* ---------------------------------------------------------------------------------------------- */ /* SUBROUTINE SECTION */ /* ---------------------------------------------------------------------------------------------- */ /* Initialization Routine - could contains anything but lets use it to get the pgm name */ /* ---------------------------------------------------------------------------------------------- */ SUBR SUBR(INZSR) SNDPGMMSG MSG('What is this program name?') TOPGMQ(*SAME) MSGTYPE(*INFO) KEYVAR(&MSGKEY) RCVMSG PGMQ(*SAME) MSGTYPE(*INFO) WAIT(0) RMV(*YES) SENDER(&SENDER) SENDERFMT(*SHORT) CHGVAR VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10)) ENDSUBR /* ---------------------------------------------------------------------------------------------- */ /* MAINLINE - If you prefer 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... */ /* The RTNSUBR can be used (like LEAVESR in RPGLE) and will exit the subroutine immediately */ 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) /* *escape */ 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 ENDPGM: ENDPGM

NickLitten


IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Shameless Trekkie, Belligerent Nerd, Englishman Abroad and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and remember: If at first you don't succeed then skydiving probably isn't a hobby you should look into.

Nick Litten

related posts:

{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
__CONFIG_colors_palette__{"active_palette":0,"config":{"colors":{"cff50":{"name":"Main Accent","parent":-1},"a344d":{"name":"Accent Transparent","parent":"cff50"}},"gradients":[]},"palettes":[{"name":"Default","value":{"colors":{"cff50":{"val":"var(--tcb-skin-color-0)"},"a344d":{"val":"rgba(46, 138, 229, 0.85)","hsl_parent_dependency":{"h":210,"l":0.54,"s":0.78}}},"gradients":[]},"original":{"colors":{"cff50":{"val":"rgb(0, 178, 255)","hsl":{"h":198,"s":1,"l":0.5}},"a344d":{"val":"rgba(0, 178, 255, 0.85)","hsl_parent_dependency":{"h":198,"s":1,"l":0.5}}},"gradients":[]}}]}__CONFIG_colors_palette__

Get In Touch

I’m always looking for awesome input, feedback and critique!

>