Like many posts in this blog, this started off as a simple explanation of one API, and quickly became a more complex scenario giving more useful information to you, the readers of this blog. It all started when I wrote about using the QCMDEXC SQL procedure. I received a message asking me why I had not used the QCMDCHK, Check Command Syntax, API before using QCMDEXC. This is a good point: How can I check if a CL string being received is valid before I pass it to either the QCMDEXC SQL function or API? And if it is not valid how can I return a useful error message?
When writing the example RPG code for this post I found that the most interesting information QCMDCHK generated about any error was written to the program message queue. This is information I want, so to get these diagnostic messages from the program message queue I would need to use another API, the Receive Program Message API, QMHRCVPM.
I thought this would be a good opportunity to give an example of using an external procedure, which can be bound to and called from multiple programs. For me to be able to retrieve what I want the procedure would need to have the calls to both APIs within it. Let me start with the first half of this procedure, its definitions:
01 **free 02 ctl-opt nomain ; 03 /define ValidateCommand 04 /copy devsrc,includes 05 /undefine ValidateCommand 06 /copy qsysinc/qrpglesrc,qusec 07 dcl-proc ValidateCommand export ; 08 dcl-pi *n char(80) ; 09 Command char(500) options(*varsize) const ; 10 end-pi ; 11 dcl-pr QCMDCHK extpgm ; 12 *n char(500) options(*varsize) const ; 13 *n packed(15:5) const ; 14 end-pr ; 15 dcl-pr QMHRCVPM extpgm ; 16 *n char(500) ; //Message info 17 *n int(10) const ; //Length of message info 18 *n char(8) const ; //Format name 19 *n char(10) const ; //Call stack entry 20 *n int(10) const ; //Call stack counter 21 *n char(10) const ; //Message type 22 *n char(4) const ; //Message key 23 *n int(10) const ; //Wait time 24 *n char(10) const ; //Message action 25 *n likeds(QUSEC) ; //Error code 26 end-pr ; 27 dcl-s ErrorMsg char(7) ; 28 dcl-s ErrorText char(80) ; 29 dcl-s MessageData char(500) ; 30 dcl-s i int(5) ; |
Line 1: Why would I not code this in totally free format RPG?
Line 2: As this source member does not contain a main procedure I need to give the control option of NOMAIN.
Lines 3 – 5: I have placed the procedure definition, DCL-PR, in an external source member. This way I can use these compiler directives to copy the same definition anywhere I need, using the create once, use many principal to ensure consistency across my applications.
Line 6: I am copying the definition for the standard API data structure from a source member in the library QSYSINC. Why bother to define it here when its definition exists elsewhere.
Line 7: This is where my procedure starts. Unlike the procedure that is included in the same source member as the main procedure that calls it, I have to include the EXPORT keyword so that its definition is available to other procedures, programs, etc.
Lines 8 – 10: Procedure interface defines that I will be receiving a 500 character parameter, line 9, that is variable in size, OPTIONS(*VARSIZE), and it is a constant, its value will not be changed or returned by this procedure. This procedure will return a 80 character parameter, line 8, to whatever calls this procedure.
Lines 11 – 14: This is the procedure definition for the QCMDCHK API. The EXTPGM, line 11, indicates that this API is an external program, and I will be using the program name, QCMDCHK, as the procedure name.
Lines 15 – 28: This is the procedure definition for the API program to receive the messages from the program message queue. Notice that only two of the parameters are not defined as constants, lines 16 and 25, these are not constants so that they can have data returned into them from the API.
Lines 27 – 30: These lines define four variables that I will be using in the procedure. The first three are character (alphanumeric) and the fourth is an integer.
Now for the rest of the procedure, the part that does stuff:
31 monitor ;
32 QCMDCHK(Command:%len(%trim(Command))) ;
33 on-error ;
34 endmon ;
35 QMHRCVPM(MessageData :
36 500 :
37 'RCVM0200' :
38 '*' :
39 0 :
40 '*DIAG' :
41 ' ' :
42 0 :
43 '*REMOVE' :
44 QUSEC) ;
45 ErrorMsg = %subst(MessageData:13:7) ;
46 if (ErrorMsg = ' ') ;
47 return '' ;
48 endif ;
49 if (ErrorMsg = 'CPD0030') ;
50 i = 201 ;
51 elseif (ErrorMsg = 'CPD0006') ;
52 i = 182 ;
53 elseif (ErrorMsg = 'CPD0071') ;
54 i = 191 ;
55 endif ;
56 ErrorText = ErrorMsg + ': ' +
%subst(MessageData:i:71) ;
57 i = %scan('.':ErrorText) ;
58 if (i > 0) ;
59 %subst(ErrorText:i) = ' ' ;
60 endif ;
61 return ErrorText ;
62 end-proc ;
|
Lines 31 – 34: I have put the call to the QCMDCHK API within a monitor group, if there is an error the program the monitor group prevents the error from breaking out of the procedure. QCMDCHK has just two parameters:
- Command string to validate
- Length of that command string, which is calculated using the Get Length built in function, %LEN.
Lines 35 – 44: Immediately after the monitor group I call the API to receive the messages from the program message queue. Only two of the parameters need to be variables, the rest are constants:
- Line 35: The returned message data variable.
- Line 36: The length of the information I want returned. I decided on 500 characters as that will cover most messages.
- Line 37: The format name for the API to use to return the message's data.
- Line 38: By using an asterisk ( * ) I am saying I want data from the current call stack entry.
- Line 39: Zero denotes that I want the most recent message from the call stack.
- Line 40: By using *DIAG message type I am saying I only want diagnostic messages received from the call stack.
- Line 41: I don't care for the message key, so I leave it blank.
- Line 42: I don't want to wait for the message to be received, so I send zero for zero seconds wait.
- Line 43: I want to remove the message from the message queue once I have received it.
- Line 44: This is the data structure to contain any errors encountered by this API.
Line 45: The diagnostic message id generated by QCMCHK is found in the returned variable, starting in position 13.
Lines 46 – 48: If there was no diagnostic error the syntax of the command is good, and I return blank to whatever called this procedure.
Lines 49 – 55: This is where it gets a bit messy as the text for the message does not start in the same place. Depending upon the diagnostic message it can start in different places, which I move to the variable i.
Line 56: I create what I am calling the error text by combining the diagnostic message id and its text.
Lines 57 – 60: I only want the first level message text. If I scan for a period ( . ) I can find the end of the first level text. Then I can clear the rest of the message variable, line 59, using a substring to move blanks to that area of the variable. I will give examples of why I do this later.
Line 61: I return the error text to whatever called this procedure.
I mentioned that the procedure definition was in another source member. The snippet of code for this definition looks like:
01 /if defined(ValidateCommand) 02 dcl-pr ValidateCommand char(80) ; 03 *n char(500) options(*varsize) const ; 04 end-pr ; 05 /endif |
Line 1: If ValidateCommand is defined then this snippet of code will be copied into the source member.
Lines 2 – 4: The procedure definition matches the procedure interface, lines 10 – 12 in my procedure's source.
I compile the member that contains my procedure into a module using the CRTRPGMOD command, option 15 if you are using PDM. I then add it to a binding directory:
Work with Binding Directory Entries
Binding Directory: MYBNDDIR Library: MYLIB
Type options, press Enter.
1=Add 4=Remove
Opt Object Type Library Activation Date
1 check_obj *module mylib
(No binding directory entries for this binding directory.)
|
Now I can create the program that will call this procedure:
01 **free
02 ctl-opt bnddir('MYBNDDIR') dftactgrp(*no) ;
03 /define ValidateCommand
04 /copy devsrc,includes
05 /undefine ValidateCommand
06 dcl-s Command char(500) ;
07 dcl-s ErrorDescription char(80) ;
08 Command = 'DLFF QTEMP/NOFILE' ;
09 ErrorDescription = ValidateCommand(Command) ;
10 Command = 'DLTF QTEMP/NOFILE' ;
11 ErrorDescription = ValidateCommand(Command) ;
12 Command = 'LSTF FILE(QTEMP/NOFILE)' ;
13 ErrorDescription = ValidateCommand(Command) ;
14 Command = 'CRTDUPOBJ OBJ(NOFILE) FROMLIB(QTEMP)' ;
15 ErrorDescription = ValidateCommand(Command) ;
16 Command = 'CLRPFM QTEMP/DUMMY' ;
17 ErrorDescription = ValidateCommand(Command) ;
18 *inlr = *on ;
|
Line 2: I am including the BNDDIR control option so that I do not have to remember to enter the binding directory when I compile this program. I also need not to use the default activation group, DFTACTGRP(*NO), as I am calling a procedure.
Lines 3 – 5: I am copying the procedure definition into this source member from the same source member the procedure did.
Line 8 – 17: I am repeatedly calling the procedures with various good and bad commands, and getting the error text back from the procedure in the variable ErrorDescription.
Lines 8 and 9: First bad command is DLFF. MESSAGEDATA, below, is what the API returned, which I format and return as ERRORDESCRIPTION to the calling program:
> EVAL MessageData
MESSAGEDATA =
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' 4 CPD003002 QCPFMSG *LIBL QSYS '
61 ' QCARULE 07F01170227161945TESTPGM1 '
121 '000001 *NO & '
181 'DLFF *LIBL Command DLFF in library *LIBL not found.'
241 'Cause . . . . . : If a library was not specified, the comm'
301 'and was not found in the libraries in the library list. If a'
361 ' library was specified, the command was not found there. One'
421 ' of the following special values may have been used to speci'
481 'fy the library: *LIB'
> EVAL ErrorDescription
ERRORDESCRIPTION =
....5...10...15...20...25...30...35...40...45...50...55...60
1 'CPD0030: Command DLFF in library *LIBL not found '
61 ' '
|
The second time I call the procedure the command string is valid: DLTF QTEMP/NOFILE, but the file does not exist in QTEMP. The syntax checking program for the DLTF command does not check if the file exists, so there is no error and blanks are returned.
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' '
61 ' '
121 ' '
181 ' '
241 ' '
301 ' '
361 ' '
421 ' '
481 ' '
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' '
61 ' '
|
The third command is one of my own. The validity checking program used by this command does check for the existence of the file in the library, therefore, a diagnostic message is generated. Notice that the first level message text starts in a different position to that generated by diagnostic message CPD0030.
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' ¡ CPD000602 QCPFMSG *LIBL QSYS '
61 ' TL9002CL 00291170227162041TESTPGM1 '
121 '000001 *NO s s '
181 ' Object NOFILE in library QTEMP not found. Object NOFILE in '
241 'library QTEMP not found.Cause . . . . . : This condition w'
301 'as diagnosed by a user-defined validity-checker program. Rec'
361 'overy . . . : Correct the error and then try the command '
421 'again. '
481 ' '
....5...10...15...20...25...30...35...40...45...50...55...60
1 'CPD0006: Object NOFILE in library QTEMP not found '
61 ' '
|
The next command is only part of the CRTDUPOBJ command, when passed to the procedure QCMDCHK rightly determines that there is a missing parameter:
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' ( ( CPD007102 QCPFMSG *LIBL QSYS '
61 ' QCAFLD 12EF1170227162112TESTPGM1 '
121 '000001 *NO È È '
181 'OBJTYPE Parameter OBJTYPE required.Cause . . . . . : A r'
241 'equired parameter was not specified. Recovery . . . : Ent'
301 'er a value for parameter OBJTYPE. '
361 ' '
421 ' '
481 ' '
....5...10...15...20...25...30...35...40...45...50...55...60
1 'CPD0071: Parameter OBJTYPE required '
61 ' '
|
The last command is valid as its syntax is correct and the file does exist in QTEMP. It should come as no surprise that the returned message data is blank:
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' '
61 ' '
121 ' '
181 ' '
241 ' '
301 ' '
361 ' '
421 ' '
481 ' '
....5...10...15...20...25...30...35...40...45...50...55...60
1 ' '
61 ' '
|
If you are going to be using these APIs you will need to test to determine if there are any other diagnostic messages returned, and where its first level message text starts.
You can learn more about this from the IBM website:
This article was written for IBM i 7.3, and should work for earlier releases too.
Did you try this with EXTPROC('system')?
ReplyDeleteIs there an advantage to using the system API?
DeleteThe system interface allows CL commands to be run using just one parameter--no length parm required. That's nice. However, system() "swallows" messages that would normally be bubbled up via QCMDEXC. There is also a C runtime export that can be used to get one of the response CPF msgs. Use IMPORT('_EXCP_MSGID') on a Char(7) variable to import it into RPG. So if you know you don't care about the CPF msgs, then system() is sometimes good enough and easier for a quick prototype than QCMDEXC. However, of late, I've been an advocate of the SQL UDF named QSYS2.qcmdexc() which accepts one or two parameters and also insures that the cl command is run in the same job or server job as the rest of the SQL statements in a program. So that's my current go-to CL command processor.
DeleteI use system(). You can check for errors using the imported message (as Bobby says)
DeleteBut I dont know of a similar API to replace QCMDCHK
This is the /copy I use for the prototype. Its old so not new style D specs. cant be bothered getting a change through change control, and it works
* Note you will need bnddir('QC2LE') in your H specs
**********************************************************************
* API to run a command
d SysCmd PR 10I 0 extproc('system')
d * value
d options(*string)
D ErrMsg S 7 import('_EXCP_MSGID')
Remember to clear ErrMsg before each call to SysCmd.
so
Clear Errmsg;
w_cmd = 'WRKSPLF'; // or whatever command you want to run.
Retcode = syscmd(w_cmd);
If ErrMsg <> *blanks;
Exsr whoops; // error handling subr
Endif;
I don't like using system() because when there's an error message, it removes the message from the joblog, but it leaves any diagnostic messages in the joblog. I like the joblog to have all the messages.
DeleteI used this command often, but I never looked to trap for an error before the command. I always checked the SQLCOD <> 0 or a specific code afterwards. Thanks for another useful tip.
ReplyDeleteVery nice. One thing i do not like in the style is vatiable "i". If i would like to do a search what that "i" is doing in the program, i would find "if" and many more stuff. Why not name the variables a bit longer to have it more unique when searcing. Maybe I100 or I400. Or I_xyz.
ReplyDeleteThere is a switch on searching (in RDi anyway) "Match Whole Word Only" which resolves the issue you seem to be having with the i variable.
Deleteyou can have variables 256 long. why would you use I. surely something like 'pos' would be more readable??
DeleteThere is a feature in RDi where you can highlight occurrences of a particular variable. If you have two instances of the variable "i" in your source, and you select one of them and click on the "Toggles marked occurrences of the given entity" button, it will only highlight the occurrences of the "i" variable that you selected.
DeleteThe "mark occurrences" button looks like a yellow felt-pen tip in the middle of the top row of icons.
If you code OPTIONS(*VARSIZE) on the parameter to your own procedure, you have to have some way of knowing what length was actually passed, to make sure you don't access too much storage. If your caller only passes say 80 bytes for the Command parameter, there could be any random storage in bytes 81-500 of the parameter in your procedure. Or you might even occasionally get MCH0601 (Space offset error).
ReplyDeleteYou could add the OPDESC keyword to the procedure, and call the CEEDOD API to find out how long the parameter is.
But I think it would be better just to remove OPTIONS(*VARSIZE) from your own parameter, so you can safely access the full 500 bytes of "Command" parameter.