Searching for strings in source files, using RPG

In my previous post, Searching for strings in source files, I included a sample program written in CL. The day it was published I received a message asking me: "Could that all be written in RPGLE instead of CL?"

The answer is: of course it can be. I thought this would be a good excuse to show how I could write a RPGLE program to do this, which would include subjects I have written about before. The RPGLE program will function in the same way the CL one does. The program is passed three parameters:

1. Search string
2. Source file name or "*ALL"
3. Source file library

The output would be spool file(s) generated by the Find String PDM command, FNDSTRPDM, where the spool file name is the source file name and the User Data is the library's name.

The example I am giving is written in fully free RPG, I will give the source code in its entirety at the bottom of this post. For now I will be breaking the code up into sections to describe what is going on. Let's start at the top with the definition of the incoming parameters and the procedures…

01 **free 02 ctl-opt main(Main) dftactgrp(*no) ; 03 dcl-pr Main extpgm('TESTSQLRPG') ; 04 *n char(30) ; 05 *n char(10) ; 06 *n char(10) ; 07 end-pr ; 08 dcl-pr qCmdExc extpgm ; 09 *n char(200) options(*varsize) const ; 10 *n packed(15:5) const ; 11 end-pr ; 12 dcl-pr ChkObject char(1) ; 13 *n char(10) value ; 14 *n char(10) value ; 15 *n char(10) value ; 16 end-pr ; 17 dcl-pr FindString ; 18 *n char(30) value ; 19 *n char(10) value ; 20 *n char(10) value ; 21 end-pr ;

Line 1: As this is written in fully free RPG then I need to start the program with **FREE. For more information about this see Trying fully free RPG. If I wanted to run this on an IBM i server that did not have the relevant PTFs I would remove this line and start the rest of the code in position 8 of the source member, and this would be compatible with IBM i 7.1 TR7 and later.

Line 2: The control options indicate that this program uses the Main procedure, and as there is DFTACTGRP it calls procedures. You can learn about the available control options in Which Control options/H-specs do you use?.

Lines 3 – 7: In a Main procedure this is where, on line 1, I define the name of the program in the EXTPGM, and on lines 4 – 6 the input parameters. For more information about the Main procedure you can read Getting off the RPG cycle.

Line 8 – 11: I will be using the QCMDEXC API, therefore, I need to define it as a procedure. As I am calling the procedure qCmdExc, which is the same name as the external program, I do not have to give its name in the EXTPGM. For more information about defining procedures see Defining Procedures in RPG all free.

Lines 12 – 16: Defines a procedure called ChkObject. The char(1) next to the procedure's name means that this will return a single character value when it is called.

Lines 17 – 21: The procedure FindString does not return any value when it is called, as there is no value defined next to the procedure name.

The Main procedure is rather long, therefore, I am going to break it into two parts to describe it.

22 dcl-proc Main ; 23 dcl-pi *n ; 24 String char(30) ; 25 SrcFile char(10) ; 26 SrcfLib char(10) ; 27 end-pi ; 28 dcl-ds Input qualified dim(100) ; 29 File char(10) ; 30 Library char(10) ; 31 end-ds ; 32 dcl-s RtnCde char(1) ; 33 dcl-s RtvRows packed(3) ; 34 dcl-s i like(RtvRows) ; 35 RtnCde = ChkObject(SrcfLib:'*LIBL':'*LIB') ; 36 if (RtnCde = '1') ; 37 return ; 38 endif ; 39 if (SrcFile <> '*ALL') ; 40 RtnCde = ChkObject(SrcFile:SrcfLib:'*FILE') ; 41 if (RtnCde = '1') ; 42 return ; 43 endif ; 44 FindString(String:SrcFile:SrcfLib) ; 45 return ; 46 endif ;

Line 22: All procedures start with a DCL-PROC.

Lines 23 – 27: The procedure interface, DCL-PI, defining the incoming parameters to this program. This is where I give the parameters their names.

Lines 28 – 31: This is a data structure array that I will use later in the Main procedure.

Line 32: RtnCde is going to contain the value returned from the ChkObject procedure.

Lines 33 and 34: These variables will be used later in the Main procedure.

Lines 35 – 38: I need to validate that the library name I have passed exists. The ChkObject does that, I am not explain what this procedure does here, I will below. It returns a value to the RtnCde variable. If a "1" is returned then library is not found and the program ends.

Lines 39 – 46: When the program is called I can either pass a source file name or "*ALL" to search all of the source files in the library. If a source file name is given I need to check that it exists. Again I use the ChkObject procedure, and return a value to RtnCde. If the source file cannot be found the program ends. If the source file does exist the FindString procedure is called, line 44.

If "*ALL" has been passed as the source file name I have to find the name of all the source files in the library. As I did in the example CL program I will use the SQL View SYSTABLES…

47 exec sql SET OPTION COMMIT = *NONE , CLOSQLCSR = *ENDMOD ; 48 exec sql DECLARE C0 CURSOR FOR SELECT SYSTEM_TABLE_NAME, SYSTEM_TABLE_SCHEMA FROM QSYS2.SYSTABLES WHERE FILE_TYPE = 'S' AND SYSTEM_TABLE_SCHEMA = :SrcfLib FOR READ ONLY ; 49 exec sql OPEN C0 ; 50 exec sql FETCH C0 FOR 100 ROWS INTO :Input ; 51 RtvRows = SQLER3 ; 52 exec sql CLOSE C0 ; 53 for i = 1 by 1 to RtvRows ; 54 FindString(String:Input(i).File:Input(i).Library) ; 55 endfor ; 56 end-proc ;

Line 47: I am defining the SQL options I want to use here. You can learn more about the options you can define in a RPG program in Putting the SQL options into the source.

Line 48: The cursor definition defines what I want to select. If I use RPG variables I need to put a colon ( : ) before the variable's name. Here I selecting the rows where the SYSTEM_TABLE_SCHEMA (library) is the same as the passed library name. I have also defined the cursor as READ ONLY as the cursor is only be used for input.

Line 49: If you are using a cursor you have to open it.

Line 50: The FETCH is the equivalent of a RPG read. I can perform a block fetch, which is the equivalent of reading multiple rows at once. In this case I decided to read 100 rows in a block into the data structure Input, which is defined on lines 28 – 31. As this is an example program I made the decision that no library could contain more than 100 source files. There is more details on block fetching in SQL blocking fetches, getting more than one row at a time.

Line 51: After a fetch SQLER3 contains the number of rows retrieved. I am storing this in the variable RtvRows to use later, as I do not want to read 100 elements in the array I fetched the data into if only few rows were retrieved.

Line 52: I have finished with the cursor, so I close it.

Lines 53 – 55: Now I read the array the same number of times as the number of rows I retrieved. I call the FindString procedure with the data structure array elements. If you are unfamiliar with the FOR operation see FOR replaces DO in RPGLE.

Line 56: All procedures must end with END-PROC.

Now onto the first procedure: ChkObject

57 dcl-proc ChkObject ; 58 dcl-pi *n char(1) ; 59 Object char(10) value ; 60 ObjLib char(10) value ; 61 ObjType char(10) value ; 62 end-pi ; 63 dcl-s CmdString char(50) ; 64 CmdString = 'CHKOBJ OBJ(' + %trimr(ObjLib) + '/' + %trimr(Object) + ') OBJTYPE(' + %trimr(ObjType) + ')' ; 65 monitor ; 66 qCmdExc(CmdString:%len(CmdString)) ; 67 on-error ; 68 return '1' ; 69 endmon ; 70 return ' ' ; 71 end-proc ;

Lines 58 – 62: My procedure interface defines the three fields passed to this procedure, and the one returned. The first time this procedure is called it was to check that the library name passed to the program existed. The Object variable contained the library name, the ObjLib contained "*LIBL" as all libraries are found in the QSYS library which should be everyone's library list, finally ObjType contained "*LIB". If this was called a second time, to check for a source file, then Object contained the source file's name, ObjLib the library it was in, and ObjType was "*FILE".

Line 63: The variable for my CL command is defined as character 50. As this is defined within this procedure a variable with the same name and with a different definition can be defined in another procedure.

Line 64: These interfaced variables are all placed in a string containing the CHKOBJ command.

Lines 65 – 69: A monitor group is like MONMSG in CL. As procedure call to qCmdExc follows the MONITOR operation code I can use the ON-ERROR to take control if the call to QCMDEXC produces as error. For example if the library or file does not exist. I am just keeping this simple, therefore, if this errors a value of "1" is returned, line 68. To learn more about this see Capturing QCMDEXC error codes.

Line 70: If no error was encountered the procedure returns a blank.

The final procedure is FindString, which is where the FNDSTRPDM command is run.

72 dcl-proc FindString ; 73 dcl-pi *n ; 74 String char(30) value ; 75 SrcFile char(10) value ; 76 SrcfLib char(10) value ; 77 end-pi ; 78 dcl-s CmdString char(120) ; 79 CmdString = 'OVRPRTF FILE(QPUOPRTF) ' + 'USRDTA(' + SrcfLib + ') SPLFNAME(' + SrcFile + ') OVRSCOPE(*CALLLVL)' ; 80 qCmdExc(CmdString:%len(CmdString)) ; 81 CmdString = 'FNDSTRPDM STRING(' + %trimr(String) + ') FILE(' + %trimr(SrcfLib) + '/' + %trimr(SrcFile) + ') MBR(*ALL) OPTION(*NONE) ' + 'PRTMBRLIST(*YES)' ; 82 qCmdExc(CmdString:%len(CmdString)) ; 83 end-proc ;

Lines 73 – 77: The procedure interface defines three incoming parameters. String is for the search string, SrcFile and SrcfLib are for the source file.

Line 78: In this procedure CmdString is defined as character 120, which is different from the same name variable in the ChkObject procedure, on line 63.

Line 79: First I want to override the print file QPUOPRTF, so that the spool file will have the source file as the spool file name and the user data will be library.

Line 80: The qCmdExc is called to make the override active.

Line 81: Now the FNDSTRPDM can be made.

Line 82: Here the qCmdExc procedure performs the FNSTRPDM.

 

Here is the source code in its entirety:

01 **free 02 ctl-opt main(Main) dftactgrp(*no) ; 03 dcl-pr Main extpgm('TESTSQLRPG') ; 04 *n char(30) ; 05 *n char(10) ; 06 *n char(10) ; 07 end-pr ; 08 dcl-pr qCmdExc extpgm ; 09 *n char(200) options(*varsize) const ; 10 *n packed(15:5) const ; 11 end-pr ; 12 dcl-pr ChkObject char(1) ; 13 *n char(10) value ; 14 *n char(10) value ; 15 *n char(10) value ; 16 end-pr ; 17 dcl-pr FindString ; 18 *n char(30) value ; 19 *n char(10) value ; 20 *n char(10) value ; 21 end-pr ; 22 dcl-proc Main ; 23 dcl-pi *n ; 24 String char(30) ; 25 SrcFile char(10) ; 26 SrcfLib char(10) ; 27 end-pi ; 28 dcl-ds Input qualified dim(100) ; 29 File char(10) ; 30 Library char(10) ; 31 end-ds ; 32 dcl-s RtnCde char(1) ; 33 dcl-s RtvRows packed(3) ; 34 dcl-s i like(RtvRows) ; 35 RtnCde = ChkObject(SrcfLib:'*LIBL':'*LIB') ; 36 if (RtnCde = '1') ; 37 return ; 38 endif ; 39 if (SrcFile <> '*ALL') ; 40 RtnCde = ChkObject(SrcFile:SrcfLib:'*FILE') ; 41 if (RtnCde = '1') ; 42 return ; 43 endif ; 44 FindString(String:SrcFile:SrcfLib) ; 45 return ; 46 endif ; 47 exec sql SET OPTION COMMIT = *NONE , CLOSQLCSR = *ENDMOD ; 48 exec sql DECLARE C0 CURSOR FOR SELECT SYSTEM_TABLE_NAME, SYSTEM_TABLE_SCHEMA FROM QSYS2.SYSTABLES WHERE FILE_TYPE = 'S' AND SYSTEM_TABLE_SCHEMA = :SrcfLib FOR READ ONLY ; 49 exec sql OPEN C0 ; 50 exec sql FETCH C0 FOR 100 ROWS INTO :Input ; 51 RtvRows = SQLER3 ; 52 exec sql CLOSE C0 ; 53 for i = 1 by 1 to RtvRows ; 54 FindString(String:Input(i).File:Input(i).Library) ; 55 endfor ; 56 end-proc ; 57 dcl-proc ChkObject ; 58 dcl-pi *n char(1) ; 59 Object char(10) value ; 60 ObjLib char(10) value ; 61 ObjType char(10) value ; 62 end-pi ; 63 dcl-s CmdString char(50) ; 64 CmdString = 'CHKOBJ OBJ(' + %trimr(ObjLib) + '/' + %trimr(Object) + ') OBJTYPE(' + %trimr(ObjType) + ')' ; 65 monitor ; 66 qCmdExc(CmdString:%len(CmdString)) ; 67 on-error ; 68 return '1' ; 69 endmon ; 70 return ' ' ; 71 end-proc ; 72 dcl-proc FindString ; 73 dcl-pi *n ; 74 String char(30) value ; 75 SrcFile char(10) value ; 76 SrcfLib char(10) value ; 77 end-pi ; 78 dcl-s CmdString char(120) ; 79 CmdString = 'OVRPRTF FILE(QPUOPRTF) ' + 'USRDTA(' + SrcfLib + ') SPLFNAME(' + SrcFile + ') OVRSCOPE(*CALLLVL)' ; 80 qCmdExc(CmdString:%len(CmdString)) ; 81 CmdString = 'FNDSTRPDM STRING(' + %trimr(String) + ') FILE(' + %trimr(SrcfLib) + '/' + %trimr(SrcFile) + ') MBR(*ALL) OPTION(*NONE) ' + 'PRTMBRLIST(*YES)' ; 82 qCmdExc(CmdString:%len(CmdString)) ; 83 end-proc ;

 

This article was written for IBM i 7.2 TR3.