03
Thu, Oct
2 New Articles

Using REXX to Indent CL Source

General
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

Make CL source code interpretation and maintenance easier with this utility.

Brief: Indenting CL code is cumbersome, especially if you (like most of us) use the command prompter. Learn how REXX gives this new utility the power to increase the readability of your CL source code and facilitate program maintenance.

Every once in a while, I have an idea for a neat utility. When the idea hits me, I write it down immediately, even if it's 3 o'clock in the morning. Living within a mile of the office has its advantages, one of which is that I can come in anytime (even at 3 a.m.) to try something out. This is precisely what happened this time.

CL is a free-format language, as you must be aware. Most programmers use the command prompter while entering the source code in SEU, meaning that all command names begin at column 14 and the first parameter's keyword is always placed on column 25. This has the advantage of providing a consistent format that everyone can quickly become familiar with.

The Problem

But wait-what happens when you code some statements within a DO/ENDDO pair? Because CL is a free-format language, it would be nice to be able to write these statements in indented form; that would make the beginning and the end of a DO group rather obvious and, therefore, the program would be far easier to read.

Unfortunately, the command prompter has no way of knowing that the command you're prompting for is being coded within a DO group. This means that CL programs written with the help of the command prompter are never indented. One must push the statements to the right by inserting spaces, which is always cumbersome, especially when there's not enough room at the right end to insert all the necessary spaces.

Looking for the Solution

So what's the solution? The straightforward approach is to write a program that will take a CL source member, indent the statements as needed, and write it back. If you have the December 1991 issue of MC, you'll remember Robin Klima's utility to indent RPG/400 source, the Indent RPG Source (INDRPGSRC) command. INDRPGSRC can be handled by an RPG program because it processes RPG source, which is columnar in nature; this means that the processing program has no trouble finding IFs, ENDs and so on.

Processing CL source (or the source of any free-format language) is a bit more complicated. Consider that a single CL statement can span several lines; that alone is different from RPG statements. Also, the IFs, DOs and ENDDOs can be anywhere within the line. Scanning free-format code with an RPG program would be difficult and the resulting program would be complicated since RPG's string handling capabilities are limited, even considering the new CAT, SCAN, SUBST and XLATE operations.

Since I like PL/I, I thought about developing the CL indenting utility in that language; but even PL/I's string handling functions are insufficient to tackle the task at hand. Besides, few subscribers would be able to use it since PL/I is not all that popular.

REXX, Of Course!

Then, at 2:30 in the morning one Friday, it hit me-I could use REXX instead of PL/I. REXX has powerful string handling functions and, what's best, everyone has REXX!

The result (after much hunt and peck, testing, cursing and debugging) is the Indent CL Source (INDCLSRC) command, which is listed in 1. It runs CL program CL001CL (2), CL program CL001CLA (3) and REXX program CL001RX (4). To give you an idea of what INDCLSRC can do for you, both CL programs included in this article are indented.

The result (after much hunt and peck, testing, cursing and debugging) is the Indent CL Source (INDCLSRC) command, which is listed in Figure 1. It runs CL program CL001CL (Figure 2), CL program CL001CLA (Figure 3) and REXX program CL001RX (Figure 4). To give you an idea of what INDCLSRC can do for you, both CL programs included in this article are indented.

INDCLSRC lets you control on what column you want to begin writing the statements (the default is column 3), how many columns to indent per DO group level (default is 3) and how many columns to indent all continuation lines (again, the default is 3).

INDCLSRC has two other features: you can order it to translate to upper or lowercase the entire source member (except quoted strings, of course), and you can save the original CL source code before indenting if you feel safer that way. You should try the lowercase option to see if you like it better than uppercase. If you've done any programming in languages other than CL and RPG, you may be used to lowercase code.

The main point to remember is that INDCLSRC indents the actual source member. Normally, it does not print an indented version, but actually changes the source code itself. Don't worry; the CL compiler will accept it after INDCLSRC has done its work, even if you requested translation to lowercase. Alternatively, you can request an indented listing-in this case, INDCLSRC does not update the original source member.

The INDCLSRC Command

The Indent CL Source (INDCLSRC) command has nine parameters:

Source member (SRCMBR): enter the name of the member you want to indent. You can also enter *ALL if you want to indent all CL source members of an entire source file. When *ALL is used, the program automatically skips all members that have a source type other than CL, CLP or CLP38.

Source file (SRCFILE): enter the qualified name of the source file being processed. It defaults to QCLSRC in *LIBL.

Convert case (CVTCASE): indicate what case conversion you want to perform. It defaults to *NONE (no case conversion). Other values are *LOWER (convert to lowercase) and *UPPER (convert to uppercase). Quoted strings and comments are never converted.

Indent remarks (INDRMKS): indent, or leave alone, all comments in the program. It defaults to *YES. If you choose *NO, remarks are not indented provided that each line begins with /*.

Output (OUTPUT): indicate where to send the output (replace the source member (*SRCMBR) or print (*PRINT)). The default is *SRCMBR.

Save old source (SAVOLDSRC): indicate whether to copy the source member to file B4INDCLSRC before replacing the source member. This parameter only appears if the OUTPUT parameter value is *SRCMBR. It defaults to *NO. If you select *YES, the member is copied to that file in the same library, using the same member name(s).

Beginning column (BGNCOL): indicate on what column to begin writing unindented statements (those found outside all DO/ENDDO groups). It defaults to 3, but any value between 1 and 14 can be entered.

Indent columns (INDCOL): tell the system how many columns to indent each nested level of DO/ENDDO. It defaults to 3. Any value between 1 and 5 can be entered.

Indent continuation (INDCONT): specify how many columns to indent continuation lines, relative to the indentation of the first line of the statement. It defaults to 3. Any value between 1 and 5 can be selected.

How Does It Work?

Explaining each and every statement in the REXX program is out of the question due to space limitations, but I'll explain the basic concepts behind the program. If you want to learn more about REXX, see the list of reference material given at the end of this article.

REXX constructs are a lot like PL/I's. Comments are coded as in CL. Blank lines are allowed, and assigning values to variables is done with the equal sign (=). You can execute any CL command directly by simply enclosing the entire command string in quotes.

REXX has three built-in "files" to communicate with the outside world: STDIN (input), STDOUT (output) and STDERR (error messages). Though not actually files, they're so similar to files that there's no harm in calling them that. Under normal circumstances, all three communicate with the user through the Extended Program Model (EPM) session manager. This means that STDIN receives what you type at the keyboard and both STDOUT and STDERR go to the screen.

But we need to be able to read and write source file members, which is not the normal use for the built-in files. Fortunately, we can run the OVRDBF command from within the REXX program to override them to something different.

CL001RX is broken down into a mainline routine and several subroutines. Each module (mainline or subroutine) begins with a tag (a name followed by a colon) and ends in a RETURN statement. The initial tag is not required for the mainline, but I like using the program's name as a tag for consistency. The subroutines are executed with the CALL statement, which works just like RPG's EXSR operation.

The Mainline Routine

The mainline uses a PARSE ARG statement to break the input parameter string into separate words, each word being a different parameter. REXX programs can only receive one parameter, which is always a character string. If you need to pass more than one parameter to a REXX program, you must concatenate the values of all the parameters and pass the resulting string as I've done. CL001RX breaks up the parameter string into SRCFLIB (source file library), SRCF (source file), SRCMBR (source member), CVTCASE (convert case), INDRMKS (indent remarks), BGNCOL (beginning column number), INDCOL (indent columns) and INDCONT (indent continuation lines).

Then I coded two statements to override the STDIN and STDOUT files. In the first one I had to override STDIN to the appropriate library, file and member; therefore, I had to build the statement from several literal strings and variables.

Using a technique known as abuttal, the variables (srcflib, srcf, and srcmbr) are concatenated to the literal strings by simply joining (abutting) them together:

 
 'ovrdbf file(stdin) tofile(' 
 srcflib'/'srcf') mbr('srcmbr')' 

The resulting CL command is:

 
 ovrdbffile(stdin) + 
 tofile(lll/fff) mbr(mmm) 

Where lll, fff and mmm are the contents of variables srcflib, srcf and srcmbr respectively.

The two OVRDBF commands redirect STDIN to the original source member and STDOUT to member WORKMBR in QTEMP/QCLSRC which was prepared by CL001CL.

After initializing a few variables, we enter an infinite loop (DO FOREVER) which reads a record in the source member with the PARSE PULL statement, receiving the entire record into variable SOURCE-RECORD. This process is repeated until no more records are found.

If SOURCE-RECORD contains all blanks beginning at position 13 (the usable portion of the source record), we write the source record immediately with the SAY statement. Else, CL001RX calls subroutine PROCESS-RECORD.

Processing Each Record

Subroutine PROCESS-RECORD does several things:

Extracts the tag in the CL statement, if one is found, and writes it in a separate line with a continuation sign (+). To determine if there's a tag, PARSE VAR splits SOURCE-DATA in two at the first blank found. TAG receives the first "word" and STATEMENT receives the rest. The built-in REXX function RIGHT then extracts one byte from the right-hand end of TAG and compares it to a colon. Notice the use of the || operator to concatenate strings, and the TRANSLATE function to convert from uppercase to lowercase or vice versa.

Writes the comment as is if INDRMKS(*NO) was specified.

Builds the entire command string by calling subroutine BUILD-COMMAND-STRING.

Converts the entire command string to uppercase or lowercase (except quoted strings) if you requested this conversion.

Formats DCL statements differently to ensure that the VAR, TYPE and LEN parameters are vertically aligned. This is done by calling subroutine FORMAT-DCL.

Finally, it writes the command string by calling subroutine WRITE.

Building the Command String

SubroutineBUILD-COMMAND-

STRING first eliminates the repeated spaces found between the command name and the first parameter's keyword, assigning the result to variable INPUT. Notice the use of the STRIP function to remove leading and trailing blanks.

Next, it enters a DO WHILE which reads subsequent records from the source member for as long as INPUT ends in a continuation symbol (either a plus or a minus sign). In the DO WHILE, the symbol | is used for or and & is used for and. These symbols are the REXX equivalents of *OR and *AND in CL.

Function LEFT extracts the specified number of bytes from the left-hand side of a string, and LENGTH calculates the length of a string.

BUILD-COMMAND-STRING uses variations of the STRIP function, with a second parameter to indicate which blanks to remove; 'B' removes both leading and trailing blanks, 'L' removes leading blanks only and 'T' removes trailing blanks only.

Formatting DCL Statements

Subroutine FORMAT-DCL breaks INPUT into several components. Decimal variables are treated differently because (a) the LEN parameter of a DCL command can omit the decimal portion, and (b) if LEN includes the decimal portion as in LEN(5 0), it would be broken down by the PARSE VAR into two variables (splitting the string at the space between the 5 and the 0).

At the end of the subroutine, INPUT is rebuilt. The LEFT function is used to pad the components with blanks at the right-hand side of the string, since it attempts to extract more characters than are available-for example, LEFT(VAR,17) requests a 17-character field; if VAR contains less than 17, whatever characters VAR contain are left-adjusted, padding the right end with blanks.

Writing the Statements

Subroutine WRITE actually writes INPUT to the work source member. First it determines if the current level is less than or equal to 10 (10 levels is the maximum levels the CL compiler will accept). It then determines how many characters are available for writing, considering the beginning column number (BGNCOL), the number of columns to indent per level (INDCOL) and the number of levels (LEVEL). It builds a string of blanks in INDENT with as many blanks as necessary to indent the statement properly, using the COPIES function to repeat a blank space a certain number of times.

Before writing anything, it calls

CALCULATE-NEXT-LEVEL to do precisely that: calculate the next level

number if the current statement happens to have a DO or ENDDO somewhere.

Then it enters a DO UNTIL loop which writes as much as possible (70 characters) to each line, breaking INPUT if it doesn't fit in its entirety. Finding a good breaking point is a crucial task delegated to subroutine BREAK-INPUT.

Calculating the Next Level

SubroutineCALCULATE-NEXT-LE-

VEL finds out if the current line contains a comment and if so, where. It also finds out if the current line contains a THEN(DO), CMD(DO), EXEC(DO) or ENDDO and if so, where. Function POS finds any of these strings within INPUT.

If any form of DO is found before the comment begins, NEXT-LEVEL is increased by 1. If ENDDO is found before the comment begins, NEXT-LEVEL is decreased by 1. Otherwise, NEXT-LEVEL is set equal to LEVEL.

Breaking the Input String

Subroutine BREAK-INPUT takes a rather brute-force approach to find a convenient breaking point for the INPUT string: it finds the last blank space at or before the point where the line must end if it is to be continued (MAXLENGTH minus 2, to be able to insert a '+' at the end). The rest of the subroutine allows for special cases where there's no breaking point (no space is found) or we must use a minus sign instead of plus sign.

Built-in REXX function LASTPOS searches INPUT backwards, starting the search for a blank space at byte number WORK-MAXLENGTH-2.

Converting to Uppercase or Lowercase

Finally, subroutine CONVERT-CASE converts every letter of the alphabet found in INPUT to upper- or lowercase, provided that it's not within quotes. This preserves quoted strings as the programmer coded them.

First, POS is used to find a single quote character within INPUT. If none is found (the position is 0), the entire INPUT string is converted to the desired case with the TRANSLATE function.

Else, we enter a DO UNTIL loop which will repeat processing until no more single quotes are encountered. The code inside the loop finds two single quotes, converts to the desired case everything before the first one, concatenates the portion within the single quotes without conversion and repeats the process. It's actually rather simple.

Programmer Friendly

INDCLSRC makes CL more programmer-friendly, and it will spoil you when you become accustomed to it. I know that from personal experience. Recently I submitted to batch several jobs to indent all members in several of our source files, using CVTCASE(*LOWER) because we favor lowercase for our internal use. Now we cannot stand the sight of a "normal" CL program!

An added bonus of INDCLSRC is that it reports to you mismatched DOs and ENDDOs. If the program has too many ENDDOs at some point, it will tell you. If the source code ends without closing a DO group, it will tell you. In both cases it does so by inserting a line having >>>---> in columns 1-7, followed by a message.

INDCLSRC has a few requirements and limitations:

The original code must use keywords in DCLs, IFs, ELSEs and MONMSGs.

Comments embedded between command parameters may confuse INDCLSRC.

INDCLSRC has a lot of code, but it's well worth the effort. You can download it from OpenBBS, and I urge you to take it for a test drive.

Further Reading

Pelkie, Craig. "A Look at REXX," MC (November 1991): 18-24.

Pelkie, Craig. "A REXXample," MC (July 1991): 34-38.

REXX Programmer's Guide, (SC24-5553-00)

REXX Reference Guide, (SC24- 5552-00)


Using REXX to Indent CL Source

Figure 1 Command INDCLSRC

 
   INDCLSRC:   CMD        PROMPT('Indent CL Source') 
 
               PARM       KWD(SRCMBR) TYPE(*NAME) LEN(10) + 
                            SPCVAL((*ALL)) MIN(1) EXPR(*YES) + 
                            PROMPT('Source member') 
               PARM       KWD(SRCFILE) TYPE(Q1) PROMPT('Source file') 
               PARM       KWD(CVTCASE) TYPE(*CHAR) LEN(6) RSTD(*YES) + 
                            DFT(*NONE) VALUES(*UPPER *LOWER *NONE) + 
                            EXPR(*YES) PROMPT('Convert case') 
               PARM       KWD(INDRMKS) TYPE(*CHAR) LEN(4) RSTD(*YES) + 
                            DFT(*YES) VALUES(*YES *NO) EXPR(*YES) + 
                            PROMPT('Indent remarks') 
               PARM       KWD(OUTPUT) TYPE(*CHAR) LEN(7) RSTD(*YES) + 
                            DFT(*SRCMBR) VALUES(*SRCMBR *PRINT) + 
                            EXPR(*YES) PROMPT('Output') 
               PARM       KWD(SAVOLDSRC) TYPE(*CHAR) LEN(4) RSTD(*YES) + 
                            DFT(*NO) VALUES(*YES *NO) EXPR(*YES) + 
                            PMTCTL(PC1) PROMPT('Save old source member') 
               PARM       KWD(BGNCOL) TYPE(*DEC) LEN(2 0) DFT(3) + 
                            RANGE(1 14) PMTCTL(*PMTRQS) + 
                            PROMPT('Beginning column') 
               PARM       KWD(INDCOL) TYPE(*DEC) LEN(1 0) DFT(3) + 
                            RANGE(1 5) PMTCTL(*PMTRQS) PROMPT('Indent + 
                            columns per level') 
               PARM       KWD(INDCONT) TYPE(*DEC) LEN(1 0) DFT(3) + 
                            RANGE(1 5) PMTCTL(*PMTRQS) PROMPT('Indent + 
                            continuation lines') 
 
   Q1:         QUAL       TYPE(*NAME) LEN(10) DFT(QCLSRC) EXPR(*YES) 
               QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) + 
                            SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) + 
                            PROMPT('Library') 
 
   PC1:        PMTCTL     CTL(OUTPUT) COND((*EQ *SRCMBR)) 

Using REXX to Indent CL Source

Figure 2 CL program CL001CL

 
  CL001CL: + 
     PGM PARM(&SRCMBR &QSRCF &CVTCASE &INDRMKS &OUTPUT &SAVOLDSRC + 
        &BGNCOL &INDCOL &INDCONT) 
 
     DCL VAR(&BGNCOL)     TYPE(*DEC)  LEN(2 0) 
     DCL VAR(&CVTCASE)    TYPE(*CHAR) LEN(6) 
     DCL VAR(&INDCOL)     TYPE(*DEC)  LEN(1 0) 
     DCL VAR(&INDCONT)    TYPE(*DEC)  LEN(1 0) 
     DCL VAR(&INDRMKS)    TYPE(*CHAR) LEN(4) 
     DCL VAR(&MSGDTA)     TYPE(*CHAR) LEN(80) 
     DCL VAR(&MSGF)       TYPE(*CHAR) LEN(10) 
     DCL VAR(&MSGFLIB)    TYPE(*CHAR) LEN(10) 
     DCL VAR(&MSGID)      TYPE(*CHAR) LEN(7) 
     DCL VAR(&OUTPUT)     TYPE(*CHAR) LEN(7) 
     DCL VAR(&QSRCF)      TYPE(*CHAR) LEN(20) 
     DCL VAR(&RTNLIB)     TYPE(*CHAR) LEN(10) 
     DCL VAR(&SAVOLDSRC)  TYPE(*CHAR) LEN(4) 
     DCL VAR(&SRCF)       TYPE(*CHAR) LEN(10) 
     DCL VAR(&SRCFLIB)    TYPE(*CHAR) LEN(10) 
     DCL VAR(&SRCMBR)     TYPE(*CHAR) LEN(10) 
     DCL VAR(&SRCTYPE)    TYPE(*CHAR) LEN(10) 
 
     /* Break qualified name */ 
     CHGVAR VAR(&SRCF) VALUE(%SST(&QSRCF 1 10)) 
     CHGVAR VAR(&SRCFLIB) VALUE(%SST(&QSRCF 11 10)) 
 
     /* If not *ALL, process member immediately */ 
     IF COND(&SRCMBR *NE '*ALL') THEN(DO) 
        RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) SRCTYPE(&SRCTYPE) 
        IF COND(&SRCTYPE *NE 'CL' *AND &SRCTYPE *NE 'CLP' *AND + 
           &SRCTYPE *NE 'CLP38') THEN(DO) 
           SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' + 
              *BCAT &SRCMBR *BCAT 'is not a CL source member') + 
              MSGTYPE(*ESCAPE) 
           RETURN 
        ENDDO 
        ELSE CMD(DO) 
           CALL PGM(CL001CLA) PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE + 
              &INDRMKS &OUTPUT &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) 
           MONMSG MSGID(CPF0000) EXEC(DO) 
              RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + 
                 MSGF(&MSGF) MSGFLIB(&MSGFLIB) 
              SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                 MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) 
              RETURN 
           ENDDO 
        ENDDO 
     ENDDO 
 
     /* Otherwise, process multiple members */ 
     ELSE CMD(DO) 
        RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(*FIRSTMBR) RTNMBR(&SRCMBR) + 
           SRCTYPE(&SRCTYPE) 
        MONMSG MSGID(CPF0000) EXEC(DO) 
           SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Source + 
              file' *BCAT &SRCF *BCAT 'in' *BCAT &SRCFLIB *BCAT 'has + 
              no members') MSGTYPE(*ESCAPE) 
           RETURN 
        ENDDO 
 
  LOOP: + 
        IF COND(&SRCTYPE *EQ 'CLP' *OR &SRCTYPE *EQ 'CLP38' *OR + 
           &SRCTYPE *EQ 'CL') THEN(DO) 
           CALL PGM(CL001CLA) PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE + 
              &INDRMKS &OUTPUT &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) 
           MONMSG MSGID(CPF0000) EXEC(DO) 
              RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + 
                 MSGF(&MSGF) MSGFLIB(&MSGFLIB) 
              SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                 MSGDTA(&MSGDTA) MSGTYPE(*DIAG) 
              SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&SRCTYPE + 
                 *BCAT 'member' *BCAT &SRCMBR *BCAT 'not processed') + 
                 MSGTYPE(*DIAG) 
              GOTO CMDLBL(NEXT) 
           ENDDO 
           SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Member' + 
              *BCAT &SRCMBR *BCAT 'indented successfully') + 
              MSGTYPE(*INFO) 
        ENDDO 
        ELSE CMD(DO) 
           SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&SRCTYPE + 
              *BCAT 'member' *BCAT &SRCMBR *BCAT 'skipped') + 
              MSGTYPE(*INFO) 
        ENDDO 
  NEXT: + 
        RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR *NEXT) + 
           RTNMBR(&SRCMBR) SRCTYPE(&SRCTYPE) 
        MONMSG MSGID(CPF0000) EXEC(RETURN) 
        GOTO CMDLBL(LOOP) 
     ENDDO 
 
     ENDPGM 

Using REXX to Indent CL Source

Figure 3 CL program CL001CLA

 
  CL001CLA: + 
     PGM PARM(&SRCMBR &SRCF &SRCFLIB &CVTCASE &INDRMKS &OUTPUT + 
        &SAVOLDSRC &BGNCOL &INDCOL &INDCONT) 
 
     DCL VAR(&BGNCOL)     TYPE(*DEC)  LEN(2 0) 
     DCL VAR(&BGNCOL_C)   TYPE(*CHAR) LEN(2) 
     DCL VAR(&CVTCASE)    TYPE(*CHAR) LEN(6) 
     DCL VAR(&INDCOL)     TYPE(*DEC)  LEN(1 0) 
     DCL VAR(&INDCOL_C)   TYPE(*CHAR) LEN(1) 
     DCL VAR(&INDCONT)    TYPE(*DEC)  LEN(1 0) 
     DCL VAR(&INDCONT_C)  TYPE(*CHAR) LEN(1) 
     DCL VAR(&INDRMKS)    TYPE(*CHAR) LEN(4) 
     DCL VAR(&MSGDTA)     TYPE(*CHAR) LEN(80) 
     DCL VAR(&MSGF)       TYPE(*CHAR) LEN(10) 
     DCL VAR(&MSGFLIB)    TYPE(*CHAR) LEN(10) 
     DCL VAR(&MSGID)      TYPE(*CHAR) LEN(7) 
     DCL VAR(&OUTPUT)     TYPE(*CHAR) LEN(7) 
     DCL VAR(&RTNLIB)     TYPE(*CHAR) LEN(10) 
     DCL VAR(&SAVOLDSRC)  TYPE(*CHAR) LEN(4) 
     DCL VAR(&SRCF)       TYPE(*CHAR) LEN(10) 
     DCL VAR(&SRCFLIB)    TYPE(*CHAR) LEN(10) 
     DCL VAR(&SRCMBR)     TYPE(*CHAR) LEN(10) 
 
     MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(SNDERRMSG)) 
 
     /* Allocate source member */ 
     ALCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) WAIT(0) 
 
     /* Send status message */ 
     SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Indenting member' + 
        *BCAT &SRCMBR *TCAT '; please wait') TOPGMQ(*EXT) + 
        MSGTYPE(*STATUS) 
     CHGJOB STSMSG(*NONE) 
 
     /* Save original source member, if requested */ 
     IF COND(&OUTPUT *EQ '*SRCMBR' *AND &SAVOLDSRC *EQ '*YES') THEN(DO) 
        CRTSRCPF FILE(&SRCFLIB/B4INDCLSRC) RCDLEN(92) TEXT('CL source + 
           saved before running INDCLSRC') 
        MONMSG MSGID(CPF0000) 
        CPYSRCF FROMFILE(&SRCFLIB/&SRCF) TOFILE(&SRCFLIB/B4INDCLSRC) + 
           FROMMBR(&SRCMBR) TOMBR(*FROMMBR) MBROPT(*REPLACE) 
     ENDDO 
 
     /* Create work member in QTEMP/QCLSRC */ 
     CRTSRCPF FILE(QTEMP/QCLSRC) RCDLEN(92) 
     MONMSG MSGID(CPF0000) 
     ADDPFM FILE(QTEMP/QCLSRC) MBR(WORKMBR) 
     MONMSG MSGID(CPF0000) 
     CLRPFM FILE(QTEMP/QCLSRC) MBR(WORKMBR) 
 
     /* Indent CL source and replace original member */ 
     CHGVAR VAR(&BGNCOL_C) VALUE(&BGNCOL) 
     CHGVAR VAR(&INDCOL_C) VALUE(&INDCOL) 
     CHGVAR VAR(&INDCONT_C) VALUE(&INDCONT) 
     RTVOBJD OBJ(CL001CL) OBJTYPE(*PGM) RTNLIB(&RTNLIB) 
     STRREXPRC SRCMBR(CL001RX) SRCFILE(&RTNLIB/QREXSRC) PARM(&SRCFLIB + 
        *BCAT &SRCF *BCAT &SRCMBR *BCAT &CVTCASE *BCAT &INDRMKS *BCAT + 
        &BGNCOL_C *BCAT &INDCOL_C *BCAT &INDCONT_C) 
     IF COND(&OUTPUT *EQ '*SRCMBR') THEN(DO) 
        CPYSRCF FROMFILE(QTEMP/QCLSRC) TOFILE(&SRCFLIB/&SRCF) + 
           FROMMBR(WORKMBR) TOMBR(&SRCMBR) MBROPT(*REPLACE) + 
           SRCOPT(*SEQNBR) SRCSEQ(1.00 1.00) 
     ENDDO 
     ELSE CMD(DO) 
        OVRPRTF FILE(QSYSPRT) PRTTXT('Member =' *BCAT &SRCMBR) 
        CPYSRCF FROMFILE(QTEMP/QCLSRC) TOFILE(*PRINT) FROMMBR(WORKMBR) 
        DLTOVR FILE(QSYSPRT) 
     ENDDO 
     DLCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) 
     GOTO CMDLBL(ENDPGM) 
 
     /* Send error message */ 
  SNDERRMSG: + 
     DLCOBJ OBJ((&SRCFLIB/&SRCF *FILE *EXCL &SRCMBR)) 
     RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + 
        MSGFLIB(&MSGFLIB) 
     SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) + 
        MSGTYPE(*ESCAPE) 
 
  ENDPGM: + 
     CHGJOB STSMSG(*USRPRF) 
 
     ENDPGM 

Using REXX to Indent CL Source

Figure 4 REXX program CL001RX

 
  mainline: 
     parse arg srcflib srcf srcmbr cvtcase indrmks bgncol indcol indcont 
 
     'ovrdbf file(stdin) tofile('srcflib'/'srcf') mbr('srcmbr')' 
     'ovrdbf file(stdout) tofile(qtemp/qclsrc) mbr(workmbr)' 
 
     level = 1 
     lowercase = 'abcdefghijklmnopqrstuvwxyz' 
     uppercase = translate(lowercase) 
 
     select 
        when cvtcase = '*UPPER' then 
           do 
              from_case = lowercase 
              to_case   = uppercase 
           end 
        when cvtcase = '*LOWER' then 
           do 
              from_case = uppercase 
              to_case   = lowercase 
           end 
        otherwise nop 
     end 
 
     do forever 
        parse pull source_record 
        if source_record = '' then 
           leave 
        if substr(source_record,13,80) = '' then 
           say source_record 
        else 
           call process_record 
     end 
 
     if level > 1 then 
        do 
           missing_enddo = level - 1 
           say sequence || date || '>>>---> ' || missing_enddo , 
              || ' missing ENDDOs detected' 
        end 
     return 
 
  /*******************************************************************/ 
  process_record: 
     sequence    = substr(source_record,1,6) 
     date        = substr(source_record,7,6) 
     source_data = substr(source_record,13,80) 
 
     /* write a separate record for CL tags */ 
     parse var source_data tag statement 
     if right(tag,1) = ':' then 
        do 
           if cvtcase = '*NONE' then 
              say sequence || date || tag || ' +' 
           else 
              say sequence || date || , 
                 translate(tag,to_case,from_case) || ' +' 
           if left(statement,1) = '+' then 
              return 
           else 
              source_data = statement 
        end 
 
     /* write comments as-is if indrmks = '*NO' */ 
     if left(strip(source_data),2) = '/*' & indrmks = '*NO' then 
        do 
           say sequence || date || source_data 
           return 
        end 
 
     /* build entire command string */ 
     call build_command_string 
 
     /* convert input case if so requested */ 
     if cvtcase <> '*NONE' & left(strip(input),2) <> '/*' then 
        call convert_case 
 
     /* format DCLs to align parameters vertically */ 
     if translate(word(input,1)) = 'DCL' then 
        call format_dcl 
 
     /* write command string */ 
     call write 
  return 
 
  /*******************************************************************/ 
  build_command_string: 
     /* eliminate repeated blanks between command and parameters */ 
     parse var source_data command parameters 
     input = strip(command) || ' ' || strip(parameters) 
 
     /* continue with next records if necessary */ 
     do while right(input,1) = '+' | right(input,1) = '-' 
        save_continuation = right(input,1) 
        input = left(input,length(input)-1) 
        parse pull source_record 
        source_data = substr(source_record,13,80) 
        if save_continuation = '+' then 
           input = input || strip(source_data,'b') 
        else 
           input = input || strip(source_data,'t') 
     end 
  return 
 
  /*******************************************************************/ 
  format_dcl: 
     parse var input dcl var type varlen other_parameters 
 
     if translate(left(varlen,4)) <> 'LEN(' then 
        do 
           other_parameters = varlen || ' ' || other_parameters 
           varlen = '' 
        end 
 
     if translate(type) = 'TYPE(*DEC)' then 
        do 
           parse var other_parameters decimals other_parameters2 
           if substr(decimals,2,1) = ')' then 
              do 
                 varlen = varlen || ' ' || decimals 
                 other_parameters = other_parameters2 
              end 
        end 
 
     input = dcl || ' ' || left(var,17) || left(type,12) || , 
        left(varlen,11) || strip(other_parameters) 
     return 
 
  /*******************************************************************/ 
  write: 
     /* indent only the first 10 levels */ 
     if level < 1 then 
        do 
           say sequence || date || '>>>---> Superfluous ENDDO found' 
           level = 1 
        end 
     if level <= 10 then 
        indent = copies(' ',indcol*(level-1)+bgncol) 
     else 
        indent = copies(' ',indcol*9+bgncol) 
 
     /* calculate maximum statement length */ 
     maxlength = 70 - length(indent) 
 
     call calculate_next_level 
     last_break_symbol = '' 
     write_indented = 'Y' 
     continued = 'N' 
 
     /* write as much as possible within the maximum length calculated */ 
     do until length(input) = 0 
        /* if entire statement fits, write it out immediately */ 
        if continued = 'Y' & length(input) <= maxlength - indcont | , 
           continued = 'N' & length(input) <= maxlength then 
           do 
              if translate(word(input,1)) = 'ENDDO' & , 
                 length(indent)-indcol > 0 then 
                 indent = left(indent,length(indent)-indcol) 
              if last_break_symbol = '-' then 
                 write_indented = 'N' 
              if write_indented = 'Y' then 
                 do 
                    if continued = 'N' 
                       then say sequence || date || indent || input 
                       else say sequence || date || indent || , 
                          copies(' ',indcont) || input 
                 end 
              else 
                 say sequence || date || input 
              level = next_level 
              input = '' 
           end 
        /* if too long, write as many words as will fit */ 
        else 
           do 
              call break_input 
              if write_indented = 'Y' then 
                 do 
                    if continued = 'N' then 
                       say sequence || date || indent || output 
                    else 
                       say sequence || date || indent || , 
                          copies(' ',indcont) || output 
                    if input <> ' ' then 
                       continued = 'Y' 
                 end 
              else 
                 say sequence || date || output 
           end 
     end 
  return 
 
  /*******************************************************************/ 
  calculate_next_level: 
     /* comment lines do not affect indentation level */ 
     if left(input,2) = '/*' then 
        next_level = level 
     /* determine if DO or ENDDO were processed */ 
     else 
        do 
           comment_starts = pos('/*',input) 
           if comment_starts = 0 then 
              comment_starts = 9999 
           then_do_starts = pos('THEN(DO)',translate(input)) 
           cmd_do_starts  = pos('CMD(DO)',translate(input)) 
           exec_do_starts = pos('EXEC(DO)',translate(input)) 
           enddo_starts   = pos('ENDDO',translate(input)) 
           select 
              when then_do_starts > 0 & , 
                   then_do_starts < comment_starts | , 
                   cmd_do_starts > 0 & , 
                   cmd_do_starts < comment_starts | , 
                   exec_do_starts > 0 & , 
                   exec_do_starts < comment_starts then 
                      next_level = level + 1 
              when enddo_starts > 0 & , 
                   enddo_starts < comment_starts then 
                      next_level = level - 1 
              otherwise 
                 next_level = level 
           end 
        end 
     if level < 1 then 
        level = 1 
  return 
 
  /*******************************************************************/ 
  break_input: 
     work_maxlength = maxlength 
     if last_break_symbol = '-' then 
        do 
           work_maxlength = 70 
           write_indented = 'N' 
        end 
     else 
        write_indented = 'Y' 
 
     if continued = 'Y' then 
        work_maxlength = work_maxlength - indcont 
     break_position = lastpos(' ',input,work_maxlength-2) 
     if break_position > 0 then 
        do 
           if substr(input,break_position+1,1) = ' ' then 
              do 
                 break_symbol = '-' 
                 output = left(input,break_position) 
              end 
           else 
              do 
                 break_symbol = ' +' 
                 output = left(input,break_position-1) 
              end 
           input = substr(input,break_position+1) 
        end 
     else 
        do 
           output = left(input,work_maxlength-2) 
           input  = substr(input,work_maxlength-1) 
           break_symbol = '+' 
        end 
 
     output = output || break_symbol 
     last_break_symbol = break_symbol 
  return 
 
  /*******************************************************************/ 
  convert_case: 
     beginning_quote = pos("'",input,1) 
     if beginning_quote = 0 then 
        input = translate(input,to_case,from_case) 
     else 
        do 
           input_accum = '' 
           do until beginning_quote = 0 
              beginning_quote = pos("'",input,1) 
              ending_quote    = pos("'",input,beginning_quote+1) 
              if beginning_quote > 0 & ending_quote > 0 then 
                 do 
                    left_portion = left(input,beginning_quote-1) 
                    middle_portion = substr(input,beginning_quote,, 
                       ending_quote-beginning_quote+1) 
                    right_portion = substr(input,ending_quote+1) 
                    input_accum = input_accum || , 
                       translate(left_portion,to_case,from_case) || , 
                       middle_portion 
                    input = right_portion 
                 end 
           end 
           input = input_accum || translate(input,to_case,from_case) 
        end 
  return 
BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$

Book Reviews

Resource Center

  • SB Profound WC 5536 Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application. You can find Part 1 here. In Part 2 of our free Node.js Webinar Series, Brian May teaches you the different tooling options available for writing code, debugging, and using Git for version control. Brian will briefly discuss the different tools available, and demonstrate his preferred setup for Node development on IBM i or any platform. Attend this webinar to learn:

  • SB Profound WP 5539More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.

  • SB HelpSystems ROBOT Generic IBM announced the E1080 servers using the latest Power10 processor in September 2021. The most powerful processor from IBM to date, Power10 is designed to handle the demands of doing business in today’s high-tech atmosphere, including running cloud applications, supporting big data, and managing AI workloads. But what does Power10 mean for your data center? In this recorded webinar, IBMers Dan Sundt and Dylan Boday join IBM Power Champion Tom Huntington for a discussion on why Power10 technology is the right strategic investment if you run IBM i, AIX, or Linux. In this action-packed hour, Tom will share trends from the IBM i and AIX user communities while Dan and Dylan dive into the tech specs for key hardware, including:

  • Magic MarkTRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now!  Request Now.

  • SB HelpSystems ROBOT GenericForms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.

  • SB HelpSystems ROBOT GenericIT security is a top priority for businesses around the world, but most IBM i pros don’t know where to begin—and most cybersecurity experts don’t know IBM i. In this session, Robin Tatam explores the business impact of lax IBM i security, the top vulnerabilities putting IBM i at risk, and the steps you can take to protect your organization. If you’re looking to avoid unexpected downtime or corrupted data, you don’t want to miss this session.

  • SB HelpSystems ROBOT GenericCan you trust all of your users all of the time? A typical end user receives 16 malicious emails each month, but only 17 percent of these phishing campaigns are reported to IT. Once an attack is underway, most organizations won’t discover the breach until six months later. A staggering amount of damage can occur in that time. Despite these risks, 93 percent of organizations are leaving their IBM i systems vulnerable to cybercrime. In this on-demand webinar, IBM i security experts Robin Tatam and Sandi Moore will reveal:

  • FORTRA Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:

  • FORTRAManaging messages on your IBM i can be more than a full-time job if you have to do it manually. Messages need a response and resources must be monitored—often over multiple systems and across platforms. How can you be sure you won’t miss important system events? Automate your message center with the Robot Message Management Solution. Key features include:

  • FORTRAThe thought of printing, distributing, and storing iSeries reports manually may reduce you to tears. Paper and labor costs associated with report generation can spiral out of control. Mountains of paper threaten to swamp your files. Robot automates report bursting, distribution, bundling, and archiving, and offers secure, selective online report viewing. Manage your reports with the Robot Report Management Solution. Key features include:

  • FORTRAFor over 30 years, Robot has been a leader in systems management for IBM i. With batch job creation and scheduling at its core, the Robot Job Scheduling Solution reduces the opportunity for human error and helps you maintain service levels, automating even the biggest, most complex runbooks. Manage your job schedule with the Robot Job Scheduling Solution. Key features include:

  • LANSA Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.

  • LANSAWhen it comes to creating your business applications, there are hundreds of coding platforms and programming languages to choose from. These options range from very complex traditional programming languages to Low-Code platforms where sometimes no traditional coding experience is needed. Download our whitepaper, The Power of Writing Code in a Low-Code Solution, and:

  • LANSASupply Chain is becoming increasingly complex and unpredictable. From raw materials for manufacturing to food supply chains, the journey from source to production to delivery to consumers is marred with inefficiencies, manual processes, shortages, recalls, counterfeits, and scandals. In this webinar, we discuss how:

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • Profound Logic Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application.

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn: