This example shows you the steps necessary to package your product like IBM products.
F*****************************************************************
F*****************************************************************
F*
F*Program Name: SFTWPRDEX
F*
F*Language: ILE RPG
F*
F*Descriptive Name: Software Product Example
F*
F*Description: This example shows you the steps necessary to
F* package your product like IBM products.
F*
F*Header Files Included: QUSEC - Error Code Parameter
F* QSZCRTPD - Create Product Definition API
F* QSZCRTPL - Create Product Load API
F* QSZPKGPO - Package Product Option API
F*
F*****************************************************************
F*****************************************************************
F*
FQPRINT O F 132 PRINTER OFLIND(*INOF) USROPN
D*
D* Error Code parameter include. As this sample program
D* uses /COPY to include the error code structure, only the first
D* 16 bytes of the error code structure are available. If the
D* application program needs to access the variable length
D* exception data for the error, the developer should physically
D* copy the QSYSINC include and modify the copied include to
D* define additional storage for the exception data.
D*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
D* Create Product Definition API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZCRTPD
D*
D* Create Product Load API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZCRTPL
D*
D* Package Product Option API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZPKGPO
D*
D* Compile Time Array
D*
DOBJ_INFO S 41 DIM(15) CTDATA PERRCD(1)
D*
DOBJ_INFO_I DS BASED(OBJ_PTR)
D OBJ_NAME 10
D OBJ_TYPE 10
D PRD_OPT_ID 4
D PRD_OPT_LD 4
D LP_ID 13
D*
D* Change Object Information parameter
D*
DCOBJI DS
D NUMKEY 9B 0 INZ(3)
D KEY13 9B 0 INZ(13)
D LEN13 9B 0 INZ(4)
D PID13 4
D KEY12 9B 0 INZ(12)
D LEN12 9B 0 INZ(4)
D LID12 4
D KEY5 9B 0 INZ(5)
D LEN5 9B 0 INZ(13)
D LP5 13
D*
D* Miscellaneous data
D*
DAPI_NAME S 10
DFIRST_ERR S 1 INZ('0')
DPROD_ID S 7 INZ('0ABCABC')
DPROD_NAME S 20 INZ('ABC0050 ABC ')
DRLS_LVL S 6 INZ('V3R1M0')
DNBR_OPTS S 9B 0 INZ(1)
DNBR_LANGS S 9B 0 INZ(1)
DTEXT_DESC S 50 INZ('ABC Product')
DPUB_AUT S 10 INZ('*USE')
DNBR_ADD_LB S 9B 0 INZ(0)
DNBR_PE S 9B 0 INZ(1)
DNBR_FLDRS S 9B 0 INZ(0)
DOBJNAM S 20
C*
C* Beginning of Mainline
C*
C* Initialize the error code parameter. To signal exceptions to
C* this program by the API, you need to set the bytes provided
C* field of the error code to zero. Because this program has
C* exceptions sent back through the error code parameter, it sets
C* the bytes provided field to the number of bytes it gives the
C* API for the parameter.
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Create Product Definition Object - ABC0050
C*
C EXSR PRDDFN (1)
C*
C* Create Product Load Objects - ABC0050 (MRM) and ABC0029 (MRI)
C*
C EXSR PRDLOD (2)
C*
C* Change Object Description for all objects associated with
C* the ABC Product.
C*
C EXSR COBJD (3)
C*
C* Package the ABC Product so that all the SAVLICPGM, RSTLIBPGM,
C* and DLTLICPGM commands work with the product.
C*
C EXSR PKGPO (4)
C*
C* All done, product is ready to ship.
C*
C EVAL *INLR = '1'
C RETURN
C*
C* End of MAINLINE
C*
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PRDDFN
C*
C* Descriptive Name: Create product definitions.
C*
C* Description: This subroutine will create the product definition
C* ABC0050 for the ABC product.
C*
C*****************************************************************
C*****************************************************************
C*
C PRDDFN BEGSR
C*
C* Setup for Product Definition
C* Fill Product Definition Information Parameter
C*
C EVAL QSZPID = PROD_ID
C EVAL QSZRL = RLS_LVL
C EVAL QSZMFIL = 'ABCMSG'
C EVAL QSZFC = '*CURRENT'
C EVAL QSZCC = '*CURRENT'
C EVAL QSZRD = '941201'
C EVAL QSZAMR = '*NO'
C EVAL QSZRIDT = '*PHONE'
C EVAL QSZRIDV = '5072535010'
C*
C* Fill Product Load Parameter
C*
C EVAL QSZOPT = '0000'
C EVAL QSZMID = 'ABC0001'
C EVAL QSZADN = '*NODYNNAM'
C EVAL QSZCL = '5001'
C EVAL QSZERVED00 = *BLANKS
C*
C* Fill Language Load List Parameter
C*
C EVAL QSZLL00 = '2924'
C EVAL QSZOPT00 = '0000'
C EVAL QSZERVED01 = *BLANKS
C*
C* Create the Product Definition for the ABC Product
C*
C CALL 'QSZCRTPD'
C PARM PROD_NAME
C PARM QSZPI
C PARM QSZPO
C PARM 1 NBR_OPTS
C PARM QSZLL
C PARM 1 NBR_LANGS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL > 0
C EVAL API_NAME = 'QSZCRTPD'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PRDLOD
C*
C* Descriptive Name: Create product loads.
C*
C* Description: This subroutine will create the product loads,
C* ABC0050 and ABC0029, for the ABC product.
C*
C*****************************************************************
C*****************************************************************
C*
C PRDLOD BEGSR
C*
C* Setup for Product Load for MRM Objects
C* Fill Product Load Information Parameter
C*
C EVAL QSZPID00 = PROD_ID
C EVAL QSZRL00 = RLS_LVL
C EVAL QSZOPT01 = '0000'
C EVAL QSZLT = '*CODE'
C EVAL QSZLID = '*CODEDFT'
C EVAL QSZRIDT00 = '*PRDDFN'
C EVAL QSZRIDV00 = *BLANKS
C EVAL QSZMTR = '*CURRENT'
C EVAL QSZERVED02 = *BLANKS
C*
C* Fill Principal Library Information Parameter
C*
C EVAL QSZDL = 'ABC'
C EVAL QSZPL = 'ABC'
C EVAL QSZPEP = 'ABCPGMMRM2'
C*
C* Fill Preoperation Exit Programs Parameter
C*
C EVAL QSZPEP00 = 'ABCPGMMRM1'
C EVAL QSZDL00 = 'ABC'
C*
C* Fill Additional Library List Parameter
C* None
C*
C* Fill Folder List Parameter
C* None
C*
C* Let's create the product load for the ABC Product - MRM Objects
C*
C CALL 'QSZCRTPL'
C PARM 'ABC0050' PROD_ID_NM 10
C PARM QSZLI
C PARM *BLANKS SEC_LANG 10
C PARM QSZLI00
C PARM QSZAL
C PARM NBR_ADD_LB
C PARM QSZPE
C PARM NBR_PE
C PARM QSZFL
C PARM NBR_FLDRS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL > 0
C EVAL API_NAME = 'QSZCRTPL'
C EXSR ERRCOD
C ENDIF
C*
C* Setup for Product Load for MRI Objects
C* Fill Product Load Information Parameter
C*
C EVAL QSZLT = '*LNG'
C EVAL QSZLID = '2924'
C*
C* Fill Principal Library Information Parameter
C*
C EVAL QSZPEP = 'ABCPGMMRI2'
C*
C* Fill Preoperation Exit Programs Parameter
C*
C EVAL QSZPEP00 = 'ABCPGMMRI1'
C*
C* Fill Additional Library List Parameter
C* None
C*
C* Fill Folder List Parameter
C* None
C*
C* Let's create the product load for the ABC Product - MRI Objects
C*
C CALL 'QSZCRTPL'
C PARM 'ABC0029' PROD_ID_NM
C PARM QSZLI
C PARM 'ABC2924' SEC_LANG
C PARM QSZLI00
C PARM QSZAL
C PARM NBR_ADD_LB
C PARM QSZPE
C PARM NBR_PE
C PARM QSZFL
C PARM NBR_FLDRS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL > 0
C EVAL API_NAME = 'QSZCRTPL'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: COBJD
C*
C* Descriptive Name: Change object descriptions for ABC Product.
C*
C* Description: This subroutine will change the object
C* descriptions for all objects that make up the
C* ABC Product. Currently that is 15 objects. They
C* are listed at the end of this program.
C*
C*****************************************************************
C*****************************************************************
C*
C COBJD BEGSR
C*
C* Need to associate all objects with the ABC Product
C*
C 1 DO 15 I 3 0
C EVAL OBJ_PTR = %ADDR(OBJ_INFO(I))
C EVAL OBJNAM = OBJ_NAME + 'ABC'
C EVAL LP5 = LP_ID
C EVAL PID13 = PRD_OPT_ID
C EVAL LID12 = PRD_OPT_LD
C EVAL TYPE = OBJ_TYPE
C*
C CALL 'QLICOBJD'
C PARM RTN_LIB 10
C PARM OBJNAM
C PARM TYPE 10
C PARM COBJI
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL > 0
C EVAL API_NAME = 'QLICOBJD'
C EXSR ERRCOD
C ENDIF
C*
C ENDDO
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PKGPO
C*
C* Descriptive Name: Package software ABC Product.
C*
C* Description: This subroutine will package the ABC Product.
C* It makes sure that all objects exist that are
C* associated with the product.
C*
C*****************************************************************
C*****************************************************************
C*
C PKGPO BEGSR
C*
C* Setup for packing the ABC Product.
C* Fill Product Option Information Parameter
C*
C EVAL QSZOPT02 = '0000'
C EVAL QSZPID01 = PROD_ID
C EVAL QSZRL01 = RLS_LVL
C EVAL QSZLID00 = '*ALL'
C EVAL QSZERVED03 = *BLANKS
C*
C* Let's package the ABC Product.
C*
C*
C CALL 'QSZPKGPO'
C PARM QSZPOI
C PARM '*YES' REPKG 4
C PARM '*NO' ALWCHG 5
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL > 0
C EVAL API_NAME = 'QSZPKGPO'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: ERROR
C*
C* Descriptive Name: Process API errors.
C*
C* Description: This subroutine will print a line to a spooled
C* file if any errors are returned in the error code
C* parameter.
C*
C*****************************************************************
C*****************************************************************
C*
C ERRCOD BEGSR
C*
C* Process errors returned from the API.
C*
C* If first error found, then open QPRINT *PRTF
C*
C IF FIRST_ERR = '0'
C OPEN QPRINT
C EVAL FIRST_ERR = '1'
C ENDIF
C*
C* Output the error and the API that received the error
C*
C EXCEPT BAD_NEWS
C*
C ENDSR
OQPRINT E BAD_NEWS 1
O 'Failed in API '
O API_NAME
O 'with error '
O QUSEI
**CTDATA OBJ_INFO
ABCPGMMRM1*PGM 000050010ABCABCV3R1M0
ABCPGMMRM2*PGM 000050010ABCABCV3R1M0
ABCPGMMRI1*PGM 000029240ABCABCV3R1M0
ABCPGMMRI2*PGM 000029240ABCABCV3R1M0
ABCPGM *PGM 000050010ABCABCV3R1M0
QCLSRC *FILE 000029240ABCABCV3R1M0
ABCDSPF *FILE 000029240ABCABCV3R1M0
ABCPF *FILE 000029240ABCABCV3R1M0
ABCMSG *MSGF 000029240ABCABCV3R1M0
ABC *CMD 000029240ABCABCV3R1M0
ABCPNLGRP *PNLGRP 000029240ABCABCV3R1M0
ABC0050 *PRDDFN 000050010ABCABCV3R1M0
ABC0050 *PRDLOD 000050010ABCABCV3R1M0
ABC0029 *PRDLOD 000029240ABCABCV3R1M0
ABC *LIB 000050010ABCABCV3R1M0