Tag: RPG

Posted on

Writing messages to the job log with RPG

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
Posted on

Read and Update with SQL

One of the advantages of SQL over native IO is that it allows you to handle sets of data rather than having to read and update each row individually. However, there can be cases where you want to handle your data line by line. To do this with SQL, you need to use a cursor.

I have a couple of examples below, both of which are written in fully free RPGLE. Going forward, all examples will be fully free because, as developers, we should all be putting the past behind us.

I am basing this on the previously mentioned Employees file, to which I have added an extra field named EMPVALID. This is numeric — a zero indicates an invalid employee number and a one indicates a valid employee number. Any number of validations or codes could be added, of course, but I want to keep things simple.

So first of all, here’s a simple program that will read and display each invalid employee.

 
      **Free
        
        // Employee records data structure
        dcl-ds EMPDS extname('EMPLOYEES')
        end-ds;

        // Ensure the cursor is not already open
        // This isn't really necessary here, but it is good practice
        exec SQL close C1;

        // Declare and open the cursor
        exec SQL declare C1 cursor for
            select EMPNUMBER, EMPNAME, EMPVALID
            from EMPLOYEES
            where EMPVALID = 0
            for fetch only;
        exec SQL open C1;

        // Read the file
        dou SQLCOD < 0 or SQLCOD = 100;
            exec SQL fetch C1 into :EMPDS;
            if SQLCOD >= 0 and SQLCOD <> 100;
                dsply (EMPNAME);
            endif;
        enddo;

        // Close the cursor and exit
        exec SQL close C1;
        *inlr = *on;

This is fine as far as it goes, but what we really want to do is check whether the employee numbers are valid and update the EMPVALID accordingly. For this, I will use the %check BIF.


      **Free

        // Employee records data structure
        dcl-ds EMPDS extname('EMPLOYEES')
        end-ds;

        // A display field to get around the limitations of the DSPLY OpCode
        dcl-s DISPLAY CHAR(52);

        // And we need a constant, digits, containing the valid characters
        dcl-c DIGITS '0123456789';

        // Ensure the cursor is not already open
        // This isn't really necessary here, but it is good practice
        exec SQL close C1;

        // Declare and open the cursor
        // Note that the last clause is now a 'for update of...'
        exec SQL declare C1 cursor for
            select EMPNUMBER, EMPNAME, EMPVALID
            from EMPLOYEES
            where EMPVALID = 0
            for update of EMPVALID;
        exec SQL open C1;

        // Read the file
        dou SQLCOD < 0 or SQLCOD = 100;
            exec SQL fetch C1 into :EMPDS;
            if SQLCOD >= 0 and SQLCOD <> 100;
                if %check(DIGITS: EMPNUMBER) > 0;
                    DISPLAY = %trim(EMPNAME) + ' is valid';
                    dsply (DISPLAY);

                    // And this is where we set EMPVALID = 1
                    // for the current record
                    exec SQL
                        update EMPLOYEES
                        set EMPVALID = 1
                        where current of C1;
                endif;
            endif;
        enddo;

        // Close the cursor and exit
        exec SQL close C1;
        *inlr = *on;

And this is the output:

DSPLY  Bugs Bunny is valid
DSPLY  Elmer Fudd is valid
DSPLY  Speedy Gonzales is valid
DSPLY  Sylvester is valid

And looking at the file, I can see everything is updated, as below:

EMPNUMBER   EMPNAME                                                  EMPVALID
00001       Bugs Bunny                                                      1
OOOO2       Elmer Fudd                                                      1
0000000003  Daffy Duck                                                      0
-4          Speedy Gonzales                                                 1
00005       Sylvester                                                       1

I told you that Elmer Fudd was tricksey.

As a rule, updating sets of data is much more efficient and should certainly be preferred for any new development. However, there are plenty of programs out there for which the business rules are tucked away in some validation subroutine which has been written to process one line at a time. In these cases, being able to process line by line with an SQL cursor gives you a handy first step towards modernising the application.

I have also found cursors to be useful when building subfiles, but that’s a whole other post.

Posted on

Editing RPGLE source members with Vim

I am very fond of the Vim text editor and will use it, out of preference, whenever possible. This includes writing RPG (and, obviously, RPGLE) programs on the IBM i. The only downside here is that, while Vim supports syntax highlighting for a multitude of languages, RPG isn’t one of them.

For a long time, I have relied on the syntax files written by Martin Rowe back in 2014. These, however, are getting more than a little long in the tooth. So, since I have a little time on my hands, I have started putting together a new set of syntax files which, hopefully, will be able to keep up with any new developments.

It’s all very early days so far, but you can find the Vim RPG Syntax highlighter here.

Feel free to download it and use it. And if you have any improvements to make or suggest, I would love to hear from you.

Posted on

On indicators

RPG has, since the beginning of time, supported a set of indicators — one byte characters that can be either *on or *off. These are popular but really shouldn’t be used any more. Being named *IN01 to *IN99 makes for indicators whose function is unclear and you are much better off using built in functions and explicitly defined fields.

There is an exception, of course. When dealing with display files, you have no choice but to use indicators to determine what keys have been pressed. Even here, though, it is a good idea to overlay the indicators with human readable field names.

This is how I do it:

 * Global variables
d IndicatorPtr    s               *   inz(%addr(*in))
d                 ds                  based(IndicatorPtr)
d iExit                   3      3
d iRefresh                5      5
d iAdd                    6      6
d iCancel                12     12
d iValidCmdKey           25     25
d iError                 30     30
d iPageDown              26     26
d iSflInit               80     80
d iSflEnd                81     81
d iSflEmpty              82     82
d iSflPosCursor          83     83
d iSflDeleted            84     84
d iProtectKey            90     90
d iProtectData           91     91

So *IN03 is mapped to field iExit, *IN05 is mapped to field iRefresh, and so on.

With the indicators defined in this way, I can write code like this:

p Main            b
d Main            pi
 /free

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

     // Main processing loop
     dou iExit = *on;
         WorkWithMessageDescriptions();
     enddo;

     return;

 /end-free
p Main            e

Note also that this Main procedure is not setting on the *LR indicator. This is because, in the header spec, I have a named main procedure:

h main(Main)

Using this tells the compiler that I am not using the RPG logic cycle and that processing should start with procedure Main. Not only does this allow me to abandon setting on *LR but also reduces a lot of the progeram’s overhead.

Posted on

Using EXTFILE to override files within RPG

So here’s the situation: Five warehouses populating five sets of files (same filenames, different libraries) and I have an RPGLE program that needs to read through each of these to accumulate dispatch information.

The traditional way of doing this would involve writing a CL program to OVRDBF to each file before calling the RPGLE program. This works, but it’s a bit messy and this can cause future maintenance problems. It’s much better, therefore, to specify the file (and library) to open within the RPGLE program itself. You can do this with the EXTFILE keyword.

Here’s an example:

 * ---------------------------------------------------------------------- *
 * Program     : LSX001R                                                  *
 * Description : Dynamically select which file to open                    *
 * ---------------------------------------------------------------------- *
h main(Main)
fMOVEMENTS if   e           k DISK    usropn extfile(filename)

d Main            pr                  extpgm('LSX001R')
d  library                      10a

dfilename         s             21a

 * ------------------------------------------------------------------------
 * Main Procedure
 * ------------------------------------------------------------------------
p Main            b
d Main            pi
d  library                      10a
 /free

     filename = %trim(library) + '/' + 'MOVEMENTS';
     open MOVEMENTS;

     // Do whatever processing on the file needs to be done...

     close MOVEMENTS;

 /end-free
p Main            e

Hopefully this is reasonably straightforward. In the file spec for the MOVEMENTS file, I have used EXTFILE with a variable filename to specify the actual file opened. I have also used the USROPN keyword as I need to populate the filename variable before I attempt to open the file.

Populating this field is pretty simple. I pass the library name to the program as a parameter and the first thing the Main procedure does is concatenate the library and file with a ‘/’ separator.

Now I can open the correct file, do whatever processing is necessary, and then close the file afterwards.

A similar approach, using the EXTMBR keyword can also be used to open a specific file member. You can, of course, combine EXTFILE and EXTMBR in order to dynamically determine both the file and member, if you really want to.

It should be noted that this will only work if you are using traditional database IO. Any embedded SQL will remain unaffected by anything you do in the F-Spec. If you want to do something similar with SQL, you will need to look into the CREATE ALIAS statement.

Posted on

Debugging RPG Programs in Batch

If you spend any time developing RPG applications you will find that, sooner or later, you will need to debug a program that runs in batch. There are a few steps that you need to take in order to do this and, because my memory is terrible, I’m putting them here.

  • Know what job queue your job is being submitted to. Hold this job queue.
  • Submit your job.
  • Your job is now sitting on the held job queue waiting to be released. Display the job and make a note of the user name, job name and number.
  • Start a service job using STRSRVJOB entering the name, job name and number from the previous step.
  • STRDBG PGM(ProgramName). You can’t enter any breakpoints yet, so hit F12 to exit the source display
  • Release the job queue
  • The Start Serviced Job screen will be displayed asking you to press F10 to enter debug commands for the job. Press F10.
  • DSPMODSRC and enter your breakpoints.
  • Press F12 to resume and F3 to return to the Start Serviced Job screen.
  • Press Enter to start your job.

The job will now begin running and will stop, passing control back to your screen, when the first breakpoint is reached.

Posted on

Service Programs and Call Stack APIs

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.