friedkiwi/ibm-information-center
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
master
ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/pgmerr_lobjp.htm

895 lines
35 KiB
HTML
Raw Permalink Normal View History

Add readme and dist folders
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="Code for new function" />
<meta name="abstract" content="The example programs in this topic create a list of all objects that adopt authority and then process the objects based on their object type." />
<meta name="description" content="The example programs in this topic create a list of all objects that adopt authority and then process the objects based on their object type." />
<meta name="DC.Relation" scheme="URI" content="pgmerr.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="pgmerr_lobjp" />
<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>Code for new function</title>
</head>
<body id="pgmerr_lobjp"><a name="pgmerr_lobjp"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Code for new function</h1>
<div><p>The example programs in this topic create a list of all objects
that adopt authority and then process the objects based on their object type.</p>
<div class="section"><p>New function from IBM<sup>®</sup> can cause programs to fail if the programs
do not allow for the handling of a new function.</p>
<p>The new function added
is the addition of another object type, *SRVPGM, which can adopt owner authority.</p>
<p>A
general theme of this example is never to assume that the values returned
by an API are static. <span class="keyword">i5/OS™</span> is
continually evolving. While the example is based on the addition of a new
object type, this philosophy should be applied to any output of an API. For
example, if an API today can return *YES or *NO, you should discretely check
for these values because *MAYBE might be valid in the future. Similarly, if
your application assumes a particular integer output has a positive nonzero
value (an offset for instance), you should check for a positive nonzero value
because future releases could return a negative value to indicate new function.</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="pgmerr_lobjp__lobjp_incorrect"><a name="pgmerr_lobjp__lobjp_incorrect"><!-- --></a><h4 class="sectiontitle">Example of incorrect coding: Code for
new function</h4><p>In this example program, a check is made to determine
the object type. This is shown at <a href="#pgmerr_lobjp__SPTRK20A">(1)</a>.
The example program considers only object types of *SQLPKG or *PGMs. This
is because they are the only object types that could adopt owner authority
before Version 2 Release 3. Since that time, a new object type of *SRVPGM
has been introduced. *SRVPGM can adopt owner authority. Hence, this example
program processes *SRVPGM objects as if they were *PGM objects. The correct
coding is shown at <a href="#pgmerr_lobjp__SPTRK23B">(2)</a>.</p>
<pre>D*****************************************************************
D*
D*Program Name: PGM1
D*
D*Program Language: ILE RPG
D*
D*Description: This example program demonstrates how a program can
D* be "broken" by new functions introduced on the system.
D*
D*
D*
D*Header Files Included: QUSGEN - Generic Header of a User Space
D* (Copied Into Program)
D* QUSEC - Error Code Parameter
D* (Copied Into Program)
D* QSYLOBJP - List Objects API
D* (Copied Into Program)
D*
D*APIs Used: QUSCRTUS - Create User Space
D* QSYLOBJP - List Objects That Adopt Owner Authority
D* QUSROBJD - Retrieve Object Description
D* QUSPTRUS - Retrieve Pointer to User Space
D*****************************************************************
D*****************************************************************
D*
D* This program demonstrates how a program can be "broken" by
C* new functions introduced on the system.
D*
D*****************************************************************
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
DSPC_NAME S 20 INZ('ADOPTS QTEMP ')
DSPC_SIZE S 9B 0 INZ(1)
DSPC_INIT S 1 INZ(X'00')
DLSTPTR S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
DRCVVAR S 8
DRCVVARSIZ S 9B 0 INZ(%SIZE(RCVVAR))
D*****************************************************************
D*
D* The following QUSGEN include is copied into this program so
D* that it can be declared as BASED on SPCPTR, as shown at <a href="#pgmerr_lobjp__SPTRK21A">(3)</a>
D* in the incorrect programs and at <a href="#pgmerr_lobjp__SPTRK21B">(4)</a> in the correct program.
D*
D*****************************************************************
D*
D*Header File Name: H/QUSGEN
D*
D*Descriptive Name: Format structures for User Space for ILE/C
D*
D*5763-SS1 (C) Copyright IBM Corp. 1994, 1994
D*All rights reserved.
D*US Government Users Restricted Rights -
D*Use, duplication or disclosure restricted
D*by GSA ADP Schedule Contract with IBM Corp.
D*
D*Description: Contains the Generic Record format headers
D* for the user space.
D*
D*Header Files Included: none.
D*
D*Macros List: none.
D*
D*Structure List: Qus_Generic_Header_0100
D* Qus_Generic_Header_0300
D*
D*Function Prototype List: none.
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 940213 LUPA: New Include
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Type Definition for the User Space Generic Header.
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR) <span class="uicontrol" id="pgmerr_lobjp__SPTRK21A"><a name="pgmerr_lobjp__SPTRK21A"><!-- --></a>(3)</span>
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Partial List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QSYLOBJP include is copied into this program so
D* that it can be declared as BASED on LSTPTR, as shown at <a href="#pgmerr_lobjp__SPTRK22A">(5)</a>
D* in the incorrect coding and <a href="#pgmerr_lobjp__SPTRK22B">(6)</a> in the correct coding.
D*
D*****************************************************************
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QSYLOBJP
D*
D*Descriptive Name: List Objects That Adopt Owner Authority.
D*
D*
D*Description: Include header file for the QSYLOBJP API.
D*
D*Header Files Included: H/QSYLOBJP
D* H/QSY
D*
D*Macros List: None.
D*
D*Structure List: OBJP0100
D* OBJP0200
D* Qsy_OBJP_Header
D*
D*Function Prototype List: QSYLOBJP
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 931222 XZY0432: New Include
D*
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Prototype for calling Security API QSYLOBJP
D*****************************************************************
D QSYLOBJP C 'QSYLOBJP'
D*****************************************************************
D*Header structure for QSYLOBJP
D*****************************************************************
DQSYOBJPH DS BASED(LSTPTR) <span class="uicontrol" id="pgmerr_lobjp__SPTRK22A"><a name="pgmerr_lobjp__SPTRK22A"><!-- --></a>(5)</span>
D* Qsy OBJP Header
D QSYUN00 1 10
D* User name
D QSYCV00 11 30
D* Continuation Value
D*****************************************************************
D*Record structure for OBJP0100 format
D*****************************************************************
DQSY0100L02 DS BASED(LSTPTR) <span class="uicontrol">(5)</span>
D* Qsy OBJP0100 List
D QSYNAME05 1 10
D QSYBRARY05 11 20
D* Qualified object name
D QSYOBJT12 21 30
D* Object type
D QSYOBJIU 31 31
D* Object in use
C*
C* Start of mainline
C*
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* Start of subroutines
C*
C*****************************************************************
C PROCES BEGSR
C*
C* This subroutine processes each entry returned by QSYLOBJP
C*
C*
C* Do until the list is complete
C*
C MOVE QUSIS LST_STATUS 1
C LST_STATUS DOUEQ 'C'
C*
C* If valid information was returned
C*
C QUSIS IFEQ 'C'
C QUSIS OREQ 'P'
C*
C* and list entries were found
C*
C QUSNBRLE IFGT 0
C*
C* set LSTPTR to the first byte of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* increment LSTPTR to the first list entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOLD + 1))
C*
C* and process all of the entries
C*
C DO QUSNBRLE
C QSYOBJT12 IFEQ '*SQLPKG'
C*
C* Process *SQLPKG type
C*
C ELSE <span class="uicontrol" id="pgmerr_lobjp__SPTRK20A"><a name="pgmerr_lobjp__SPTRK20A"><!-- --></a>(1)</span>
C* |
C* This 'ELSE' logic is the potential bug in this program. In |
C* releases prior to V2R3 only *SQLPKGs and *PGMs could adopt |
C* owner authority, and this program is assuming that if the |
C* object type is not *SQLPKG then it must be a *PGM. In V2R3 |
C* a new type of object (the *SRVPGM) was introduced. As this |
C* program is written, all *SRVPGMs that adopt the owner profile |
C* will be processed as if they were *PGMs -- this erroneous |
C* processing could definitely cause problems. |
C* |
C QSYNAME05 DSPLY |
C END V
C*
C* after each entry, increment LSTPTR to the next entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSSEE + 1))
C END
C END
C*
C* When all entries in this user space have been processed, check
C* if more entries exist than can fit in one user space
C*
C QUSIS IFEQ 'P'
C*
C* by resetting LSTPTR to the start of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* and then incrementing LSTPTR to the input parameter header
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOIP + 1))
C*
C* If the continuation handle in the input parameter header is
C* blank, then set the list status to Complete
C*
C QSYCV00 IFEQ *BLANKS
C MOVE 'C' LST_STATUS
C ELSE
C*
C* Else, call QSYLOBJP reusing the User Space to get more
C* List entries
C*
C MOVE QSYCV00 CONTIN_HDL
C EXSR GETLST
C MOVE QUSIS LST_STATUS
C END
C END
C ELSE
C*
C* And if an unexpected status, log an error (not shown) and exit
C*
C EXSR DONE
C END
C END
C ENDSR
C*****************************************************************
C GETLST BEGSR
C*
C* Call QSYLOBJP to generate a list
C* The continuation handle is set by the caller of this subroutine.
C*
C CALL QSYLOBJP
C PARM SPC_NAME
C PARM 'OBJP0100' MBR_LIST 8
C PARM '*CURRENT' USR_PRF 10
C PARM '*ALL' OBJ_TYPE 10
C PARM CONTIN_HDL 20
C PARM QUSEC
C*
C* Check for errors on QSYLOBJP
C*
C QUSBAVL IFGT 0
C MOVEL 'QSYLOBJP' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C INIT BEGSR
C*
C* One-time initialization code for this program
C*
C* Set error code structure to not use exceptions
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Check to see if the user space was previously created in
C* QTEMP. If it was, simply reuse it.
C*
C CALL 'QUSROBJD'
C PARM RCVVAR
C PARM RCVVARSIZ
C PARM 'OBJD0100' ROBJD_FMT 8
C PARM SPC_NAME
C PARM '*USRSPC' OBJ_TYPE 10
C PARM QUSEC
C*
C* Check for errors on QUSROBJD
C*
C QUSBAVL IFGT 0
C*
C* If CPF9801, then user space was not found
C*
C QUSEI IFEQ 'CPF9801'
C*
C* So create a user space for the list generated by QSYLOBJP
C*
C CALL 'QUSCRTUS'
C PARM SPC_NAME
C PARM 'QSYLOBJP ' EXT_ATTR 10
C PARM SPC_SIZE
C PARM SPC_INIT
C PARM '*ALL' SPC_AUT 10
C PARM *BLANKS SPC_TEXT 50
C PARM '*YES' SPC_REPLAC 10
C PARM QUSEC
C PARM '*USER' SPC_DOMAIN 10
C*
C* Check for errors on QUSCRTUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSCRTUS' APINAM 10
C EXSR APIERR
C END
C*
C* Else, an error occurred accessing the user space
C*
C ELSE
C MOVEL 'QUSROBJD' APINAM 10
C EXSR APIERR
C END
C END
C*
C* Set QSYLOBJP (using GETLST) to start a new list
C*
C MOVE *BLANKS CONTIN_HDL
C EXSR GETLST
C*
C* Get a resolved pointer to the user space for performance
C*
C CALL 'QUSPTRUS'
C PARM SPC_NAME
C PARM SPCPTR
C PARM QUSEC
C*
C* Check for errors on QUSPTRUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSPTRUS' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C APIERR BEGSR
C*
C* Log any error encountered, and exit the program
C*
C APINAM DSPLY QUSEI
C EXSR DONE
C ENDSR
C*****************************************************************
C DONE BEGSR
C*
C* Exit the program
C*
C EVAL *INLR = '1'
C RETURN
C ENDSR</pre>
</div>
<div class="section" id="pgmerr_lobjp__lobjp_correct"><a name="pgmerr_lobjp__lobjp_correct"><!-- --></a><h4 class="sectiontitle">Example: Code for new function of correct
coding</h4><p>In the following example program, code has been written that
checks for object types *SRVPGM, *PGM, and *SQLPKG. If an object type is encountered
that is unknown (it does not match *SRVPGM, *PGM, or *SQLPKG), an error is
logged and an exit from the program takes place.</p>
<p>The coding to handle
the integration of new function (in this case the new object type that can
adopt owner authority) is shown at <a href="#pgmerr_lobjp__SPTRK23B">(2)</a>.</p>
<pre>C*****************************************************************
C*
C*Program Name: PGM2
C*
C*Program Language: ILE RPG
C*
C*Description: This example program demonstrates how a program can
C* be coded to accept new functions introduced on the system.
C*
C*
C*
C*Header Files Included: QUSGEN - Generic Header of a User Space
D* (Copied Into Program)
C* QUSEC - Error Code Parameter
D* (Copied Into Program)
C* QSYLOBJP - List Objects API
D* (Copied Into Program)
C*
C*APIs Used: QUSCRTUS - Create User Space
C* QSYLOBJP - List Objects That Adopt Owner Authority
C* QUSROBJD - Retrieve Object Description
C* QUSPTRUS - Retrieve Pointer to User Space
C*****************************************************************
H
C*****************************************************************
C*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
DSPC_NAME S 20 INZ('ADOPTS QTEMP ')
DSPC_SIZE S 9B 0 INZ(1)
DSPC_INIT S 1 INZ(X'00')
DLSTPTR S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
DRCVVAR S 8
DRCVVARSIZ S 9B 0 INZ(%SIZE(RCVVAR))
D*****************************************************************
D*
D* The following QUSGEN include is copied into this program so
D* that it can be declared as BASED on SPCPTR, as shown at <a href="#pgmerr_lobjp__SPTRK21A">(3)</a>
D* in the incorrect program and at <a href="#pgmerr_lobjp__SPTRK21B">(4)</a> in the correct program.
D*
D*****************************************************************
D*
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QUSGEN
D*
D*Descriptive Name: Format structures for User Space for ILE/C
D*
D*
D*5763-SS1 (C) Copyright IBM Corp. 1994, 1994
D*All rights reserved.
D*US Government Users Restricted Rights -
D*Use, duplication or disclosure restricted
D*by GSA ADP Schedule Contract with IBM Corp.
D*
D*Description: Contains the Generic Record format headers
D* for the user space.
D*
D*Header Files Included: none.
D*
D*Macros List: none.
D*
D*Structure List: Qus_Generic_Header_0100
D* Qus_Generic_Header_0300
D*
D*Function Prototype List: none.
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 940213 LUPA: New Include
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Type Definition for the User Space Generic Header.
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR) <span class="uicontrol" id="pgmerr_lobjp__SPTRK21B"><a name="pgmerr_lobjp__SPTRK21B"><!-- --></a>(4)</span>
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Partial List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QSYLOBJP include is copied into this program so
D* that it can be declared as BASED on LSTPTR, as shown at <a href="#pgmerr_lobjp__SPTRK22A">(5)</a>
D* in the incorrect coding and at <a href="#pgmerr_lobjp__SPTRK22B">(6)</a> in the correct coding.
D*
D*
D*****************************************************************
D*** START HEADER FILE SPECIFICATIONS ****************************
D*
D*Header File Name: H/QSYLOBJP
D*
D*Descriptive Name: List Objects That Adopt Owner Authority.
D*
D*
D*Description: Include header file for the QSYLOBJP API.
D*
D*Header Files Included: H/QSYLOBJP
D* H/QSY
D*
D*Macros List: None.
D*
D*Structure List: OBJP0100
D* OBJP0200
D* Qsy_OBJP_Header
D*
D*Function Prototype List: QSYLOBJP
D*
D*Change Activity:
D*
D*CFD List:
D*
D*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
D*---- ------------ ----- ------ --------- ----------------------
D*$A0= D2862000 3D10 931222 XZY0432: New Include
D*
D*End CFD List.
D*
D*Additional notes about the Change Activity
D*End Change Activity.
D*** END HEADER FILE SPECIFICATIONS ******************************
D*****************************************************************
D*Prototype for calling Security API QSYLOBJP
D*****************************************************************
D QSYLOBJP C 'QSYLOBJP'
D*****************************************************************
D*Header structure for QSYLOBJP
D*****************************************************************
DQSYOBJPH DS BASED(LSTPTR) <span class="uicontrol" id="pgmerr_lobjp__SPTRK22B"><a name="pgmerr_lobjp__SPTRK22B"><!-- --></a>(6)</span>
D* Qsy OBJP Header
D QSYUN00 1 10
D* User name
D QSYCV00 11 30
D* Continuation Value
D*****************************************************************
D*Record structure for OBJP0100 format
D*****************************************************************
DQSY0100L02 DS BASED(LSTPTR) <span class="uicontrol">(6)</span>
D* Qsy OBJP0100 List
D QSYNAME05 1 10
D QSYBRARY05 11 20
D* Qualified object name
D QSYOBJT12 21 30
D* Object type
D QSYOBJIU 31 31
D* Object in use
C*
C* Start of mainline
C*
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* Start of subroutines
C*
C*****************************************************************
C PROCES BEGSR
C*
C* This subroutine processes each entry returned by QSYLOBJP
C*
C*
C* Do until the list is complete
C*
C MOVE QUSIS LST_STATUS 1
C*
C LST_STATUS DOUEQ 'C'
C*
C* If valid information was returned
C*
C QUSIS IFEQ 'C'
C QUSIS OREQ 'P'
C*
C* and list entries were found
C*
C QUSNBRLE IFGT 0
C*
C* set LSTPTR to the first byte of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* increment LSTPTR to the first list entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOLD + 1))
C*
C* and process all of the entries
C*
C DO QUSNBRLE
C QSYOBJT12 IFEQ '*SQLPKG'
C*
C* Process *SQLPKG type <span class="uicontrol" id="pgmerr_lobjp__SPTRK23B"><a name="pgmerr_lobjp__SPTRK23B"><!-- --></a>(2)</span>
C* |
C ELSE |
C QSYOBJT12 IFEQ '*PGM' |
C* |
C* Process *PGM type |
C* |
C QSYNAME05 DSPLY |
C ELSE |
C QSYOBJT12 IFEQ '*SRVPGM' |
C* |
C* Process *SRVPGM type |
C* |
C ELSE |
C* V
C*
C* Unknown type, log an error and exit from program (maybe..)
C*
C EXSR DONE
C END
C END
C END
C*
C* after each entry, increment LSTPTR to the next entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSSEE + 1))
C END
C END
C*
C* When all entries in this user space have been processed, check
C* if more entries exist than can fit in one user space
C*
C QUSIS IFEQ 'P'
C*
C* by resetting LSTPTR to the start of the user space
C*
C EVAL LSTPTR = SPCPTR
C*
C* and then incrementing LSTPTR to the input parameter header
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOIP + 1))
C*
C* If the continuation handle in the input parameter header is
C* blank, then set the list status to complete.
C*
C QSYCV00 IFEQ *BLANKS
C MOVE 'C' LST_STATUS
C ELSE
C*
C* Else, call QSYLOBJP reusing the user space to get more
C* list entries
C*
C MOVE QSYCV00 CONTIN_HDL
C EXSR GETLST
C MOVE QUSIS LST_STATUS
C END
C END
C ELSE
C*
C* And if an unexpected status, log an error (not shown) and exit
C*
C EXSR DONE
C END
C END
C ENDSR
C*****************************************************************
C GETLST BEGSR
C*
C* Call QSYLOBJP to generate a list
C* The continuation handle is set by the caller of this subroutine.
C*
C CALL QSYLOBJP
C PARM SPC_NAME
C PARM 'OBJP0100' MBR_LIST 8
C PARM '*CURRENT' USR_PRF 10
C PARM '*ALL' OBJ_TYPE 10
C PARM CONTIN_HDL 20
C PARM QUSEC
C*
C* Check for errors on QSYLOBJP
C*
C QUSBAVL IFGT 0
C MOVEL 'QSYLOBJP' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C INIT BEGSR
C*
C* One time initialization code for this program
C*
C* Set error code structure to not use exceptions
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Check to see if the user space was previously created in
C* QTEMP. If it was, simply reuse it.
C*
C CALL 'QUSROBJD'
C PARM RCVVAR
C PARM RCVVARSIZ
C PARM 'OBJD0100' ROBJD_FMT 8
C PARM SPC_NAME
C PARM '*USRSPC' OBJ_TYPE 10
C PARM QUSEC
C*
C* Check for errors on QUSROBJD
C*
C QUSBAVL IFGT 0
C*
C* If CPF9801, then user space was not found
C*
C QUSEI IFEQ 'CPF9801'
C*
C* So create a user space for the list generated by QSYLOBJP
C*
C CALL 'QUSCRTUS'
C PARM SPC_NAME
C PARM 'QSYLOBJP ' EXT_ATTR 10
C PARM SPC_SIZE
C PARM SPC_INIT
C PARM '*ALL' SPC_AUT 10
C PARM *BLANKS SPC_TEXT 50
C PARM '*YES' SPC_REPLAC 10
C PARM QUSEC
C PARM '*USER' SPC_DOMAIN 10
C*
C* Check for errors on QUSCRTUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSCRTUS' APINAM 10
C EXSR APIERR
C END
C*
C* Else, an error occurred accessing the user space
C*
C ELSE
C MOVEL 'QUSROBJD' APINAM 10
C EXSR APIERR
C END
C END
C*
C* Set QSYLOBJP (using GETLST) to start a new list
C*
C MOVE *BLANKS CONTIN_HDL
C EXSR GETLST
C*
C* Get a resolved pointer to the user space for performance
C*
C CALL 'QUSPTRUS'
C PARM SPC_NAME
C PARM SPCPTR
C PARM QUSEC
C*
C* Check for errors on QUSPTRUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSPTRUS' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C APIERR BEGSR
C*
C* Log any error encountered, and exit the program
C*
C APINAM DSPLY QUSEI
C EXSR DONE
C ENDSR
C*****************************************************************
C DONE BEGSR
C*
C* Exit the program
C*
C EVAL *INLR = '1'
C RETURN
C ENDSR</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="pgmerr.htm" title="Provides information about common programming errors, as well as examples of correct and incorrect coding.">Common API programming errors</a></div>
</div>
</div>
</body>
</html>
Reference in New Issue Copy Permalink