This program registers an OPM COBOL Error Handler. After the successful completion of the registration of the error handler, this , program creates a data decimal error. This exception causes the error handler to be called which then logs the software error.
This example uses two programs: CBLERR1 causes the error, and ERRHDL1 shows how to log the software error using the QPDLOGER API. Refer to Example in ILE C: Logging software error (OPM API without pointers) for the original example.
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program: Register an OPM COBOL Error Handler
* Cause a data decimal exception to demonstrate
* logging of software errors
*
* Language: COBOL
*
* Description: This program registers an OPM COBOL Error
* Handler. After the successful completion of
* the registration of the error handler, this ,
* program creates a data decimal error. This
* exception causes the error handler to be
* called which then logs the software error.
*
* APIs Used: QLRSETCE - Set COBOL Error Handler
*
***************************************************************
*
***************************************************************
PROGRAM-ID. CBLERR1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
* Error Code parameter include. As this sample program
* uses COPY to include the error code structure, only the first
* 16 bytes of the error code structure are available. If the
* application program needs to access the variable length
* exception data for the error, the developer should physically
* copy the QSYSINC include and modify the copied include to
* define additional storage for the exception data.
*
COPY QUSEC OF QSYSINC-QLBLSRC.
*
* Miscellaneous elements
*
01 MISC.
05 Y PIC S9(09) VALUE 0.
05 ERROR-HANDLER PIC X(20) VALUE "ERRHDL1 *LIBL ".
05 SCOPE PIC X(01) VALUE "C".
05 ERROR-HANDLER-LIBRARY PIC X(10).
05 PRIOR-ERROR-HANDLER PIC X(20).
01 NUMERIC-GROUP.
05 X PIC 9(03).
*
* Beginning of mainline
*
PROCEDURE DIVISION.
MAIN-LINE.
*
* Register the COBOL Error Handler.
*
* Initialize the error code parameter. To signal exceptions to
* this program by the API, you need to set the bytes provided
* field of the error code to zero. Because this program has
* exceptions sent back through the error code parameter, it sets
* the bytes provided field to the number of bytes it gives the
* API for the parameter.
*
MOVE 16 TO BYTES-PROVIDED.
*
*
* Call the API to register the exit point.
*
CALL "QLRSETCE" USING ERROR-HANDLER OF MISC,
SCOPE OF MISC,
ERROR-HANDLER-LIBRARY OF MISC,
PRIOR-ERROR-HANDLER OF MISC,
QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE OF QUS-EC > 0
DISPLAY "Error setting handler",
STOP RUN.
*
* If the call to register an error handler is successful, then
* cause a the data decimal error (X is initialized to blanks).
*
ADD X TO Y.
*
* Should not get here due to data decimal error
*
STOP RUN.
*
* End of MAINLINE
*
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program: Log a software error
*
* Language: COBOL
*
* Description: This program receives control for exceptions
* within a COBOL run unit. This program is used
* in conjunction with CBLERR1. ,
* Any exception causes this error handler to be
* called which then logs the software error.
*
* APIs Used: QPDLOGER - Log Software Error
*
***************************************************************
*
***************************************************************
PROGRAM-ID. ERRHDL1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
* Error Code parameter include. As this sample program
* uses COPY to include the error code structure, only the first
* 16 bytes of the error code structure are available. If the
* application program needs to access the variable length
* exception data for the error, the developer should physically
* copy the QSYSINC include and modify the copied include to
* define additional storage for the exception data.
*
COPY QUSEC OF QSYSINC-QLBLSRC.
*
* Miscellaneous elements
*
01 MISC.
05 LOG-EXCEPTION-ID PIC X(12).
05 MESSAGE-KEY PIC X(04).
05 POINT-OF-FAILURE PIC S9(09) BINARY VALUE 1.
05 PRINT-JOBLOG PIC X(01) VALUE "Y".
05 NBR-OF-ENTRIES PIC S9(09) BINARY.
05 NBR-OF-OBJECTS PIC S9(09) BINARY VALUE 1.
01 MESSAGE-INFO.
05 MSG-OFFSET PIC S9(09) BINARY.
05 MSG-LENGTH PIC S9(09) BINARY.
01 OBJECT-LIST.
05 OBJECT-NAME PIC X(30).
05 LIBRARY-NAME PIC X(30).
05 OBJECT-TYPE PIC X(10) VALUE "*PGM ".
LINKAGE SECTION.
01 CBL-EXCEPTION-ID PIC X(07).
01 VALID-RESPONSES PIC X(06).
01 PGM-IN-ERROR.
05 PGM-NAME PIC X(10).
05 LIB-NAME PIC X(10).
01 SYS-EXCEPTION-ID PIC X(07).
01 MESSAGE-TEXT PIC X(01).
01 MESSAGE-LENGTH PIC S9(09) BINARY.
01 SYS-OPTION PIC X(01).
*
* Beginning of mainline
*
PROCEDURE DIVISION USING CBL-EXCEPTION-ID,
VALID-RESPONSES,
PGM-IN-ERROR,
SYS-EXCEPTION-ID,
MESSAGE-TEXT,
MESSAGE-LENGTH,
SYS-OPTION.
MAIN-LINE.
*
* Initialize the error code parameter. To signal exceptions to
* this program by the API, you need to set the bytes provided
* field of the error code to zero. Because this program has
* exceptions sent back through the error code parameter, it sets
* the bytes provided field to the number of bytes it gives the
* API for the parameter.
*
MOVE 16 TO BYTES-PROVIDED.
*
* Record the COBOL Exception id
*
MOVE SYS-EXCEPTION-ID TO LOG-EXCEPTION-ID.
*
* Record the length of the message replacement data (if any)
*
IF MESSAGE-LENGTH > 0
MOVE 1 TO MSG-OFFSET,
MOVE MESSAGE-LENGTH TO MSG-LENGTH,
MOVE 1 TO NBR-OF-ENTRIES,
ELSE
MOVE 0 TO MSG-OFFSET,
MOVE 0 TO MSG-LENGTH,
MOVE 0 TO NBR-OF-ENTRIES.
*
* For illustration purposes, dump the program object
*
MOVE PGM-NAME TO OBJECT-NAME. (1)
MOVE LIB-NAME TO LIBRARY-NAME.
*
* Call the API to log the software error.
*
CALL "QPDLOGER" USING PGM-NAME,
LOG-EXCEPTION-ID,
MESSAGE-KEY,
POINT-OF-FAILURE,
PRINT-JOBLOG,
MESSAGE-TEXT,
MESSAGE-INFO,
NBR-OF-ENTRIES,
OBJECT-LIST,
NBR-OF-OBJECTS,
QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE OF QUS-EC > 0
DISPLAY "Cannot log erro".
*
* End the current run unit
*
MOVE "C" TO SYS-OPTION.
STOP RUN.
*
* End of MAINLINE
*