Tag: API

I have previously mentioned using Qp0zLprintf (Print Formatted Job Log Data) to write messages to the joblog. Here’s an alternative approach using QMHSNDPM (Send Program Message). In this case, I am executing an SQL statement and checking the SQL state afterwards. If the state is not 00000 (completed normally), I use the LogError procedure to write the SQL code to the job log.

Obviously, it would be better to put the LogError procedure into a service program both for reusability and so that the QMHSNDPM prototype definition can be tucked out of the way.

This is the program:

        // Simple program to demonstrate sending SQL error states to the joblog
        // Written by Paul Pritchard

        ctl-opt main(Main) dftactgrp(*no) actgrp(*new);

        // --------------------------------------------------------------------
        // External Procedures
        // --------------------------------------------------------------------
        dcl-pr WriteJoblog extpgm('QMHSNDPM');
            MessageID char(7) const;
            MessageFile char(20) const;
            Message char(32767) const options(*varsize);
            MessageLength int(10) const;
            MessageType char(10) const;
            MessageStack char(10) const;
            MessageStackC int(10) const;
            MessageKey char(4);
            MessageError char(32767) options(*varsize);
        end-pr;


        // --------------------------------------------------------------------
        // Program main procedure
        // --------------------------------------------------------------------
        dcl-proc Main;
            dcl-pi *n end-pi;

            exec sql
                update employees
                set empvalid = 0
                where int(empnumber) < 0;

            if SQLSTATE <> '00000';
                LogError(SQLSTATE);
            endif;

            return;

        end-proc;

        // --------------------------------------------------------------------
        // Simple SQL Error Logging
        // --------------------------------------------------------------------
        dcl-proc LogError;

            dcl-pi LogError;
                ErrorCode char(5) const;
            end-pi;

            // The API message fields
            dcl-s MessageID char(7) inz('CPF9897');
            dcl-s MessageFile char(20) inz('QCPFMSG   *LIBL');
            dcl-s Message varchar(32767) inz;
            dcl-s MessageLength int(10) inz;
            dcl-s MessageType char(10) inz('*DIAG');
            dcl-s MessageStack varchar(32767) inz('*');
            dcl-s MessageStackC int(10) inz;
            dcl-s MessageKey char(4) inz;

            dcl-ds MessageError qualified;
                Input int(10) inz;
                Output int(10) inz;
            end-ds;


            Message = 'SQL Error encountered: ' + ErrorCode;
            MessageLength = %len(%trim(Message));
            WriteJoblog(MessageID: MessageFile: Message:
                        MessageLength: MessageType:
                        MessageStack: MessageStackC: MessageKey: MessageError);

            return;

        end-proc;
        // --------------------------------------------------------------------

And this is what it looks like in the joblog:

CPF9897    Diagnostic             40   17-11-12  18:31:37.319725  LSE001R
                                    From module . . . . . . . . :   SQLJOBLOG
                                    From procedure  . . . . . . :   LOGERROR
                                    Statement . . . . . . . . . :   137
                                    To module . . . . . . . . . :   SQLJOBLOG
                                    To procedure  . . . . . . . :   LOGERROR
                                    Statement . . . . . . . . . :   137
                                    Message . . . . :   SQL Error encountered: 22023
                                    Cause . . . . . :   No additional online help information is available.

So here’s a fun situation. An interface that works perfectly in the test environment but which randomly falls over in production. Better still, it’s part of the overnight batch processing so it tends to fall over at around 9:30 in the evening.

I need to be able to determine what the program is doing when it fails, specifically, in this case, what the data being processed looks like, but I don’t want to stay up half the night in order to do so.

Fortunately, there’s Qp0zLprintf (Print Formatted Job Log Data).

The Qp0zLprintf() function prints user data specified by format-string as an information message type to the job log.

If a second parameter, argument-list, is provided, Qp0zLprintf() converts each entry in the argument-list and writes the entry to the job log according to the corresponding format specification in format-string. If there are more entries in argument-list than format specifications in format-string, the extra argument-list entries are evaluated and then ignored. If there are less entries in argument-list than format specifications in format-string, the job log output for those entries is
undefined, and the Qp0zLprintf() function may return an error.

What this means, is that I can write out to the joblog at various points within the program so that I can pinpoint exactly what the program was doing and what data was being processed when it failed.

So here’s a simplified sample of what I mean

      **Free

        // Simple program to demonstrate writing to the job log
        // Written by Paul Pritchard

        ctl-opt dftactgrp(*no) actgrp(*new)
            main(Main);

        dcl-pr WriteJobLog int(10) extproc('Qp0zLprintf');
            *n pointer value options(*string);
        end-pr;

        dcl-proc Main;
            dcl-pi *n end-pi;

            dcl-s Message varchar(512);
            dcl-c CRLF x'0d25';

            // The easy way to put a message in the joblog
            // Is to construct the text, then print it
            Message = 'Hello World' + CRLF;
            WriteJobLog(Message);

            // And exit
            return;
        end-proc;

That CRLF is the hex codes for Carriage Return and Line Feed. You need to ensure that it’s tacked onto the end of each message to ensure the messages all remain readably laid out.

And this is what the output looks like

*NONE      Information                  17-10-11  14:36:17.490255  QP0ZCPA      QSYS        *STMT    QP0ZCPA     QSYS        *STMT
                                     From module . . . . . . . . :   QP0ZUDBG
                                     From procedure  . . . . . . :   Qp0zVLprintf
                                     Statement . . . . . . . . . :   64
                                     To module . . . . . . . . . :   QP0ZUDBG
                                     To procedure  . . . . . . . :   Qp0zVLprintf
                                     Statement . . . . . . . . . :   64
                                     Message . . . . :   Hello World

I’m a big fan of service programs. From a maintainability point of view, encapsulated procedures are great. And exported procedures, which mean you only need to develop any piece of functionality once, are even better.

However, I now find myself in the position of having to start creating a set of these from scratch (nothing to copy/paste) and, since they can be a bit fiddly, now seems like a good time to document the steps.

In the example that follows, I create a service program with a single procedure, RtvProgram, which returns the name of the program that called the service program. It sounds a bit recursive, I know, but bear with me. Whenever coding a display file (or a report, for that matter) I like to put the program name somewhere on the screen (top left, unless someone tells me otherwise). This means that when someone has a problem, we can very quickly identify what program they are talking about.

Obviously, hard-coding the program name in the display file would be easy. But code gets copied and pasted and, sooner or later, all hard coded values end up being wrong. I have also seen cases of one display file being used by two or more programs, so it is much better to put the program name in a field and retrieve it dynamically. That way, you are always getting the right program.

So on to the service program.

First, you need a copy member to contain the procedure prototype. You could, of course, code the prototype in each program that uses the service program, but that way madness lies.

In my case, I have created the copy member in QRPGLESRC and called it LSS001RP. It looks like this:

 * Retrieve Program Name
d RtvProgram      pr            10a   

And then you need to write the service program:

 * ---------------------------------------------------------------------- *
 * Program     : LSS001R                                                  *
 * Description : Program information service programs                     *
 * ---------------------------------------------------------------------- *
h nomain

 * ---------------------------------------------------------------------- *
 * Exportable Prototypes                                                  *
 * ---------------------------------------------------------------------- *
 /copy LSCLIB/qrpglesrc,lss001rp

 * ---------------------------------------------------------------------- *
 * API Prototypes                                                         *
 * ---------------------------------------------------------------------- *
d RtvCallStack    pr                  extpgm('QWVRCSTK')
d                             2000a
d                               10i 0
d                                8a
d                               56a
d                                8a
d                               15a

 * ---------------------------------------------------------------------- *
 * RtvProgram: Retrieve the program name                                  *
 * ---------------------------------------------------------------------- *
p RtvProgram      b                   export
d RtvProgram      pi            10a

d Var             ds          2000    qualified
d  BytAvl                       10i 0
d  BytRtn                       10i 0
d  Entries                      10i 0
d  Offset                       10i 0
d  Count                        10i 0

d JobID           ds                  qualified
d  QName                        26a   inz('*')
d  IntID                        16a
d  Res3                          2a   inz(*loval)
d  ThreadInd                    10i 0 inz(1)
d  Thread                        8a   inz(*loval)

d Entry           ds                  qualified
d  Length                       10i 0
d  Program                      10a   overlay(Entry: 25)
d  Library                      10a   overlay(Entry: 35)

d VarLength       s             10i 0 inz(%size(Var))
d RcvFormat       s              8a   inz('CSTK0100')
d JobIdFmt        s              8a   inz('JIDF0100')
d ApiError        s             15a
d i               s             10i 0
 /free

     RtvCallStack(Var: VarLength: RcvFormat: JobID: JobIdFmt : ApiError);
     for i = 1 to 2;
         Entry = %subst(Var: Var.Offset + 1);
         Var.Offset += Entry.Length;
     endfor;

     return Entry.Program;

 /end-free
p RtvProgram      e
 * ---------------------------------------------------------------------- * 

I’m not going to go into too much detail here. The service program LSS001R contains one procedure, RtvProgram which uses the QWVRCSTK API to retrieve the current call stack then it reads back two entries: The first entry is the service program and the second entry is the calling program. And this is the program name that it returns.

You now need to create the RPG Module. Note the terminology here — you are not creating a Bound RPG Program (it’s the difference between options 15 and 14 in PDM).

I also need the binding source. In this case, the member is called LSS001S and I have put it in the QSRVSRC source file. It looks like this:

STRPGMEXP  PGMLVL(*CURRENT)
    EXPORT SYMBOL('RTVPROGRAM')
ENDPGMEXP

Note that the capitalisation is actually important here.

And now I’m ready to create the service program:

CRTSRVPGM SRVPGM(LSCLIB/LSS001R) MODULE(LSCLIB/LSS001R) SRCFILE(LSCLIB/QSRVSRC) SRCMBR(LSS001S)

Since I’m doing this from scratch, I need to create a binder directory:

CRTBNDDIR BNDDIR(LSCLIB/LSBNDDIR) TEXT('General purpose binding directory')

And add the service program to it:

ADDBNDDIRE BNDDIR(LSCLIB/LSBNDDIR) OBJ((LSS001R))

And we’re ready to go. All I have to do now is make a couple of amendments to the main program to take advantage of the service program:

The control spec needs this line:

h bnddir('LSBNDDIR')                                                       

Obviously, I need to copy the prototype definition somewhere in the definition specification:

 /copy LSCLIB/qrpglesrc,lss001rp                                       

And when the program starts, I need to identify the name of the program:

 /free

     // Identify the current program
     program = RtvProgram();
                                                                           

And that’s it.