Example in OPM RPG: List APIs
This OPM RPG program prints a report that shows all objects that adopt owner authority.
Note: By using the code examples, you agree to the terms of the Code license and disclaimer information.
F*
F*****************************************************************
F*****************************************************************
F*****************************************************************
F*****************************************************************
F*
F*Program Name: List objects which adopt owner authority
F*
F*Language: OPM RPG
F*
F*Description: This program prints a report showing all objects
F* that adopt owner authority. The two parameters
F* passed to the program are the profile to be
F* checked and the type of objects to be listed.
F* The parameter values are the same as those
F* accepted by the QSYLOBJP API.
F*
F*APIs Used: QSYLOBJP - List Objects that Adopt Owner Authority
F* QUSCRTUS - Create User Space
F* QUSROBJD - Retrieve Object Description /
F* QUSRTVUS - Retrieve From User Space /
F*
F*****************************************************************
F*****************************************************************
F*
FQSYSPRT O F 132 OF PRINTER
F***************************************************************
I/COPY QSYSINC/QRPGSRC,QSYLOBJP
I/COPY QSYSINC/QRPGSRC,QUSROBJD
I/COPY QSYSINC/QRPGSRC,QUSGEN
C*****************************************************************
I* Error Code Structure
I*
I* This shows how the user can define the variable length portion
I* of error code for the exception data.
I*
I*/COPY QSYSINC/QRPGSRC,QUSEC
I*** START HEADER FILE SPECIFICATIONS ****************************
I*
I*Header File Name: H/QUSEC
I*
I*Descriptive Name: Error Code Parameter.
I*
I*5763-SS1, 5722-SS1 (C) Copyright IBM Corp. 1994, 2001
I*All rights reserved.
I*US Government Users Restricted Rights -
I*Use, duplication or disclosure restricted
I*by GSA ADP Schedule Contract with IBM Corp.
I*
I*Licensed Materials-Property of IBM
I*
I*
I*Description: Include header file for the error code parameter.
I*
I*Header Files Included: None.
I*
I*Macros List: None.
I*
I*Structure List: Qus_EC_t
I* Qus_ERRC0200_t
I*
I*Function Prototype List: None.
I*
I*Change Activity:
I*
I*CFD List:
I*
I*FLAG REASON LEVEL DATE PGMR CHANGE DESCRIPTION
I*---- ------------ ----- ------ --------- ----------------------
I*$A0= D2862000 3D10 931201 DPOHLSON: New Include
I*$B1= D9179400 3D60 940904 GEORGE : Add Qus_ERRC0200_t
I* structure.
I*
I*End CFD List.
I*
I*Additional notes about the Change Activity
I*End Change Activity.
I*** END HEADER FILE SPECIFICATIONS ******************************
I*****************************************************************
I*Record structure for Error Code Parameter
I**** ***
I*NOTE: The following type definition only defines the fixed
I* portion of the format. Varying length field Exception
I* Data will not be defined here.
I*****************************************************************
IQUSBN DS
I* Qus EC
I B 1 40QUSBNB
I* Bytes Provided
I B 5 80QUSBNC
I* Bytes Available
I 9 15 QUSBND
I* Exception Id
I 16 16 QUSBNF
I* Reserved
I* Following statement was uncommented and 17 was changed to 100
I 17 100 QUSBNG
I*
I* Varying length
IQUSKY DS
I* Qus ERRC0200
I B 1 40QUSKYB
I* Key
I B 5 80QUSKYC
I* Bytes Provided
I B 9 120QUSKYD
I* Bytes Available
I 13 19 QUSKYF
I* Exception Id
I 20 20 QUSKYG
I* Reserved
I B 21 240QUSKYH
I* CCSID
I B 25 280QUSKYJ
I* Offset Exc Data
I B 29 320QUSKYK
I* Length Exc Data
I* 33 33 QUSKYL
I* Reserved2
I*
I* 34 34 QUSKYM
I*
I*
I* Global Variables
I*
I DS
I 1 10 APINAM
I 11 30 CONHDL
I I 'QSYSLOBJP ' 31 40 EXTATR
I 41 41 LSTSTS
I I 'OBJP0200' 42 49 MBRLST
I I 'OBJD0100' 68 75 RJOBDF
I I '*ALL ' 76 85 SPCAUT
I I '*USER ' 86 95 SPCDMN
I I X'00' 96 96 SPCINT
I I 'ADOPTS QTEMP ' 97 116 SPCNAM
I I '*YES ' 117 126 SPCREP
I 127 176 SPCTXT
I I '*USRSPC ' 177 186 SPCTYP
I I 8 B 197 2000RCVLEN
I B 201 2040SIZENT
I I 1 B 205 2080SPCSIZ
I B 209 2120I
I B 213 2160NUMENT
I B 217 2200OFFSET
I B 221 2240STRPOS
IRCVVAR DS 2000
C*
C* Beginning of Mainline
C*
C* Two parameters are being passed into this program.
C*
C *ENTRY PLIST
C PARM USRPRF 10
C PARM OBJTYP 10
C*
C*****************************************************************
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* End of MAINLINE
C*
C*
C*****************************************************************
C* Function: getlst
C*
C* Description: This function calls QSYLOBJP to build a list.
C*
C*****************************************************************
C*
C GETLST BEGSR
C MOVEL'OBJP0200'MBRLST
C*****************************************************************
C* Call QSYLOBJP API to generate a list. The continuation handle
C* is set by the caller of this function.
C*****************************************************************
C CALL 'QSYLOBJP'
C PARM SPCNAM User space/lib
C PARM MBRLST Member list
C PARM USRPRF User profile
C PARM OBJTYP Object type sc
C PARM CONHDL Continuation ha (3)
C PARM QUSBN Error Code
C*****************************************************************
C* Check for errors on QSYLOBJP.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QSYLOBJP'APINAM
C EXSR APIERR
C ENDIF
C ENDSR
C*****************************************************************
C* Function: INIT
C*
C* Description: This function does all the necessary
C* initialization for this program and the
C* rest is done in the I specs.
C*****************************************************************
C INIT BEGSR
C*****************************************************************
C Z-ADD100 QUSBNB
C*****************************************************************
C* Call QUSROBJD to see if the user space was previously created
C* in QTEMP. If it was, simply reuse it.
C*****************************************************************
C CALL 'QUSROBJD'
C PARM RCVVAR Receiver Var
C PARM RCVLEN Rec Var Length
C PARM RJOBDF Format
C PARM SPCNAM Qual User Space
C PARM SPCTYP User object typ
C PARM QUSBN Error Code
C*
C QUSBNC IFGT 0
C*****************************************************************
C* If a CPF9801 error was received, then the user space was not
C* found.
C*****************************************************************
C QUSBND IFEQ 'CPF9801'
C*****************************************************************
C* Create a user space for the list generated by QSYLOBJP.
C*****************************************************************
C CALL 'QUSCRTUS'
C PARM SPCNAM Qual User Space
C PARM EXTATR Extended Attrib
C PARM SPCSIZ Size user space
C PARM SPCINT Space Initializ
C PARM SPCAUT Public Authorit
C PARM SPCTXT User space text
C PARM SPCREP Replace existin
C PARM QUSBN Error Code
C PARM SPCDMN Domain of us
C*****************************************************************
C* Check for errors on QUSCRTUS.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QUSCRTUS'APINAM
C EXSR APIERR
C ENDIF
C*****************************************************************
C* An error occurred accessing the user space.
C*****************************************************************
C ELSE
C MOVEL'QUSROBJD'APINAM
C EXSR APIERR
C ENDIF CPF9801 ELSE
C ENDIF BYTAVL > 0
C*****************************************************************
C* Set QSYLOBJP (via GETLST) to start a new list.
C*****************************************************************
C MOVE *BLANKS CONHDL
C EXSR GETLST
C*****************************************************************
C* Let's retrieve the generic header information from the user
C* space since OPM RPG does not have pointer support.
C*****************************************************************
C Z-ADD1 STRPOS
C Z-ADD192 RCVLEN Format 100
C CALL 'QUSRTVUS'
C PARM SPCNAM Qual User Space
C PARM STRPOS Start Position
C PARM RCVLEN Length of Data
C PARM QUSBP Receiver Var.
C PARM QUSBN Error Code
C*****************************************************************
C* Check for errors on QUSRTVUS.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QUSRTVUS'APINAM
C EXSR APIERR
C ENDIF
C 1 ADD QUSBPQ STRPOS Offset to List (5)
C ENDSR
C*****************************************************************
C* Function: proc2
C*
C* Description: This function processes each entry returned by
C* QSYLOBJP.
C*
C*****************************************************************
C PROC2 BEGSR
C CALL 'QUSRTVUS'
C PARM SPCNAM Qual User Space
C PARM STRPOS Start Position
C PARM SIZENT Length of Data
C PARM QSYB6 Receiver Var.
C PARM QUSBN Error Code
C*****************************************************************
C* Check for errors on QUSRTVUS.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QUSRTVUS'APINAM
C EXSR APIERR
C ENDIF
C EXCPTPRTENT
C*****************************************************************
C* After each entry, increment to the next entry.
C*****************************************************************
C STRPOS ADD SIZENT STRPOS (7)
C ENDSR
C*****************************************************************
C* Function: proc1
C*
C* Description: This function processes each entry returned by
C* QSYLOBJP.
C*
C*****************************************************************
C PROC1 BEGSR
C*****************************************************************
C* If valid information was returned. (1)
C*****************************************************************
C Z-ADDQUSBPS NUMENT
C QUSBPJ IFEQ 'P'
C QUSBPJ OREQ 'C'
C NUMENT IFGT 0
C*****************************************************************
C* Get the size of each entry to use later. (4)
C*****************************************************************
C Z-ADDQUSBPT SIZENT
C*****************************************************************
C* Increment to the first list entry.
C*****************************************************************
C 1 ADD QUSBPQ OFFSET
C*****************************************************************
C* Process all of the entries.
C*****************************************************************
C 1 DO NUMENT I (6)
C EXSR PROC2
C ENDDO
C*****************************************************************
C* If all entries in this user space have been processed, check
C* if more entries exist than can fit in one user space.
C****************************************************************
C QUSBPJ IFEQ 'P'
C*****************************************************************
C* Address the input parameter header.
C*****************************************************************
C 1 ADD QUSBPL STRPOS
C Z-ADD68 RCVLEN Format 100
C CALL 'QUSRTVUS'
C PARM SPCNAM Qual User Space
C PARM STRPOS Start Position
C PARM RCVLEN Length of Data
C PARM QUSBP Receiver Var.
C PARM QUSBN Error Code
C*****************************************************************
C* Check for errors on QUSRTVUS.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QUSRTVUS'APINAM
C EXSR APIERR
C ENDIF
C*****************************************************************
C* If the continuation handle in the input parameter header
C* is blank, then set the list status to complete.
C*****************************************************************
C QSYCRJ IFEQ *BLANKS
C MOVE 'C' LSTSTS
C ELSE
C***************************************************************
C* Else, call QSYLOBJP reusing the user space to get more
C* list entries.
C****************************************************************
C MOVELQSYCRJ CONHDL (2)
C EXSR GETLST
C Z-ADD1 STRPOS
C Z-ADD192 RCVLEN Format 100
C CALL 'QUSRTVUS'
C PARM SPCNAM Qual User Space
C PARM STRPOS Start Position
C PARM RCVLEN Length of Data
C PARM QUSBP Receiver Var.
C PARM QUSBN Error Code
C*****************************************************************
C* Check for errors on QUSRTVUS.
C*****************************************************************
C QUSBNC IFGT 0
C MOVEL'QUSRTVUS'APINAM
C EXSR APIERR
C ENDIF
C MOVE QUSBPJ LSTSTS
C ENDIF HDL = BLANKS
C ENDIF INFOSTS = 0
C ELSE
C*****************************************************************
C*If there exists an unexpected status, log an error (not shown)
C*and exit.
C*****************************************************************
C EXSR DONE done();
C ENDIF #ENT > 0
C ENDIF USRSPC=P/C
C ENDSR
C*****************************************************************
C* Function: proces
C*
C* Description: Processes entries until they are complete.
C*
C*****************************************************************
C PROCES BEGSR
C MOVELQUSBPJ LSTSTS
C LSTSTS DOUEQ'C'
C LSTSTS OREQ 'I'
C EXSR PROC1 proces1();
C ENDDO
C ENDSR
C*****************************************************************
C* Function: done
C*
C* Description: Exits the program.
C*
C*****************************************************************
C DONE BEGSR
C EXCPTENDLST
C SETON LR
C ENDSR
C*****************************************************************
C* Function: apierr
C*
C* Description: This function prints the API name, and exception
C* identifier of an error that occurred.
C*****************************************************************
C APIERR BEGSR
C APINAM DSPLY
C QUSBND DSPLY
C EXSR DONE
C ENDSR
O*****************************************************************
O* Function: PRTENT
O*
O* Description: This function prints the information returned in
O* user space.
O*****************************************************************
OQSYSPRT E 106 PRTENT
O 'Object: '
O QSYB6C
O 'Library: '
O QSYB6D
O 'Type: '
O QSYB6F
O 'Text: '
O QSYB6J
O*****************************************************************
O* Function: ENDLST
O*
O* Description: This function prints the end of listing print
O* line and returns to the caller.
O*****************************************************************
OQSYSPRT E 106 ENDLST
O '*** End of List'
The value in the information status field is shown at (1). The continuation handle in the header section to return the remaining information to the user space is shown at (2). The user then passes this value back to the API as an input parameter so that the API can locate the remaining information and place it in the user space, as shown at (3).
Processing a list
This is the preferred method for processing lists. To correctly process through a list, take the following actions:
- Use the offset to list data section field (5).
- Look at the number of list entries field in the list (6).
- For processing lists with fixed-length entries, add the size of each entry field to get to the start of the next entry (7).
- For variable-length entries, add the length of the entry (or displacement in some cases) to the next entry.
IBM might add fields to the bottom of formats in future releases. If this occurs and your code uses the size of each entry for a previous release, your list will not process at the start of each entry.
The example program defines the size of each entry at (4).