ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/opmLoggingCOBOL.htm

287 lines
13 KiB
HTML
Raw Normal View History

2024-04-02 14:02:31 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en-us" xml:lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="security" content="public" />
<meta name="Robots" content="index,follow" />
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
<meta name="DC.Type" content="reference" />
<meta name="DC.Title" content="Example in OPM COBOL: Logging software error (OPM API without pointers)" />
<meta name="abstract" content="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." />
<meta name="description" content="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." />
<meta name="DC.Relation" scheme="URI" content="opmIlecompare.htm" />
<meta name="DC.Relation" scheme="URI" content="opmLoggingILEC.htm" />
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Format" content="XHTML" />
<meta name="DC.Identifier" content="opmLoggingCOBOL" />
<meta name="DC.Language" content="en-us" />
<!-- All rights reserved. Licensed Materials Property of IBM -->
<!-- US Government Users Restricted Rights -->
<!-- Use, duplication or disclosure restricted by -->
<!-- GSA ADP Schedule Contract with IBM Corp. -->
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
<link rel="stylesheet" type="text/css" href="./ic.css" />
<title>Example in OPM COBOL: Logging software error (OPM API without pointers)</title>
</head>
<body id="opmLoggingCOBOL"><a name="opmLoggingCOBOL"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Example in OPM COBOL: Logging software error (OPM API without pointers)</h1>
<div><p>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.</p>
<div class="section"><p> This example uses two programs: <a href="#opmLoggingCOBOL__CBLERR1">CBLERR1</a> causes
the error, and <a href="#opmLoggingCOBOL__ERRHDL1">ERRHDL1</a> 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.</p>
<div class="note"><span class="notetitle">Note:</span> Read the <a href="codedisclaimer.htm">Code license and disclaimer information</a> for important
legal information.</div>
</div>
<div class="section" id="opmLoggingCOBOL__CBLERR1"><a name="opmLoggingCOBOL__CBLERR1"><!-- --></a><h4 class="sectiontitle">CBLERR1 program</h4><pre> 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 &gt; 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
*</pre>
</div>
<div class="section" id="opmLoggingCOBOL__ERRHDL1"><a name="opmLoggingCOBOL__ERRHDL1"><!-- --></a><h4 class="sectiontitle">ERRHDL1 program</h4><pre> 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 &gt; 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. <span class="uicontrol">(1)</span>
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 &gt; 0
DISPLAY "Cannot log erro".
*
* End the current run unit
*
MOVE "C" TO SYS-OPTION.
STOP RUN.
*
* End of MAINLINE
*</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="opmIlecompare.htm" title="This topic gives an overview of how Original Program Model (OPM) APIs and Integrated Language Environment (ILE) APIs differ from each other. The ILE APIs include the UNIX-type APIs and the ILE CEE APIs, among others.">OPM and ILE API differences</a></div>
</div>
<div class="relref"><strong>Related reference</strong><br />
<div><a href="opmLoggingILEC.htm" title="This program illustrates how to use APIs to log software errors using FFDC.">Example in ILE C: Logging software error (OPM API without pointers)</a></div>
</div>
</div>
</body>
</html>