|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4TVD5.
*REMARKS
*****************************************************************
* *
* @START_COPYRIGHT@ *
* Statement: Licensed Materials - Property of IBM *
* *
* 5695-137 *
* (C) Copyright IBM Corporation. 1993, 1997 *
* *
* Status: Version 1 Release 2 *
* @END_COPYRIGHT@ *
* *
* ************************************************************* *
* *
* Product Number : 5695-137 *
* *
* Module Name : CSQ4TVD5 *
* *
* Environment : MVS TSO/ISPF; COBOL II *
* *
* Function : This program provides nickname creation *
* function for the mail manager sample. *
* See IBM MQSeries for MVS/ESA *
* Application Programming Reference, *
* for further details. *
* *
* Description : This program will allow the user to define*
* nicknames for users of the system *
* that are commonly contacted. This program *
* will put all requests on to the *
* SYSTEM.COMMAND.INPUT queue to be processed*
* by the command server. All replies will *
* be returned on a temporary dynamic queue *
* based on the model queue *
* SYSTEM.DEFAULT.MODEL.QUEUE. *
* *
* ************************************************************* *
* *
* Program Logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* Define required variables to ISPF *
* Display the create nickname panel (CSQ4VDP5) *
* *
* Do while return code form ISPF is zero *
* Perform VALIDATE-USER-ENTRY *
* If valid user entry *
* Perform CREATE-NICKNAME *
* End-if *
* Update the message variables in the shared pool *
* Display the create nickname panel *
* End-do *
* *
* Return to ISPF *
* *
* *
* VALIDATE-USER-ENTRY SECTION *
* --------------------------- *
* If no nickname has been entered *
* Build 'enter valid nickname' message *
* Else *
* Check that nickname entered starts in the first *
* position of the variable and contains no spaces *
* If check fails *
* Build 'enter valid nickname' message *
* Else *
* If no userid has been entered *
* Build 'Enter valid userid' message *
* Else *
* Check that userid entered starts in the first *
* position of the variable and contains no spaces*
* If check fails *
* Build 'enter valid userid' message *
* End-if *
* End-if *
* End-if *
* End-if *
* *
* Return to performing section *
* *
* *
* SET-UP-NICKNAME-FIELDS SECTION *
* ------------------------------ *
* Put the information from ISPF variables *
* into the program variables to be used for nickname *
* checking and creation *
* *
* Return to performing section *
* *
* *
* CHECK-NICKNAME SECTION *
* ---------------------- *
* Set the variables for the open call *
* Open the nickname queue for inquire *
* If the call is successful *
* Build 'nickname already exists' message *
* Else *
* If reason for call failure is not unknown object name*
* Build error message *
* Else *
* Set message to spaces *
* End-if *
* End-if *
* *
* Return to performing section *
* *
* *
* CREATE-NICKNAME SECTION *
* ----------------------- *
* Perform SET-UP-NICKNAME-FIELDS *
* Perform CHECK-NICKNAME *
* Evaluate *
* When message not spaces *
* do nothing (because there is an error) *
* When user has not entered a queue manager name *
* Perform CREATE-ALIAS-QUEUE *
* Otherwise *
* If queue manager name is not local queue manager *
* Perform CREATE-REMOTE-QUEUE *
* Else *
* Perform CREATE-ALIAS-QUEUE *
* End-if *
* End-evaluate *
* *
* Return to performing section *
* *
* *
* CREATE-REMOTE-QUEUE SECTION *
* --------------------------- *
* Perform CREATE-TEMP-DYNAMIC-QUEUE *
* If the queue is not created successfully *
* Build an error message *
* Go to CREATE-REMOTE-QUEUE-EXIT *
* End-if *
* *
* Initialize the variables for the put1 call *
* Put the define queue message on the system command queue*
* If the open is not successful *
* Build an error message *
* Else *
* Perform GET-COMMAND-SERVER-RESP *
* End-if *
* *
* Perform CLOSE-TEMP-DYNAMIC-QUEUE *
* *
* CREATE-REMOTE-QUEUE-EXIT *
* *
* Return to performing section *
* *
* *
* CREATE-ALIAS-QUEUE SECTION *
* -------------------------- *
* Perform CREATE-TEMP-DYNAMIC-QUEUE *
* If the queue is not created successfully *
* Build an error message *
* Go to CREATE-ALIAS-QUEUE-EXIT *
* End-if *
* *
* Initialize the variables for the put1 call *
* Put the define queue message on the system command queue*
* If the open is not successful *
* Build an error message *
* Else *
* Perform GET-COMMAND-SERVER-RESP *
* End-if *
* *
* Perform CLOSE-TEMP-DYNAMIC-QUEUE *
* *
* CREATE-ALIAS-QUEUE-EXIT *
* *
* Return to performing section *
* *
* *
* CREATE-TEMP-DYNAMIC-QUEUE SECTION *
* --------------------------------- *
* Initialize the variables for the open call *
* Create the temporary dynamic queue by opening the model *
* queue *
* *
* Return to performing section *
* *
* *
* GET-COMMAND-SERVER-RESPONSE SECTION *
* ----------------------------------- *
* Initialize the variables for the get call *
* Do until expected response message received or get fails*
* Get the message *
* If compcode not ok *
* If not no message available *
* Build an error message *
* End-if *
* Else *
* If expected message received *
* If queue was created successfully *
* Set create-worked to Y *
* Else *
* Set create-worked to N *
* Perform GET-ERROR-DETAILS *
* End-if *
* End-if *
* End-if *
* End-do *
* *
* If create queue worked *
* Set 'nickname created' message *
* End-if *
* *
* Return to performing section *
* *
* *
* CLOSE-TEMP-DYNAMIC-QUEUE SECTION *
* -------------------------------- *
* Close the queue *
* *
* Return to performing section *
* *
* *
* GET-ERROR-DETAILS SECTION *
* ------------------------- *
* Initialize the variables for the get call *
* Get the next message from the temporary queue *
* Move the message received to the display message 2 line *
* *
* Initialize the variables for the get call *
* Get the next message from the temporary queue *
* Move the message received to the display message 3 line *
* *
* Return to performing section *
* *
* ************************************************************* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-NICKNAME PIC X(08) VALUE SPACES.
01 W00-USERQ PIC X(08) VALUE SPACES.
01 W00-VALIDATE PIC X(01) VALUE SPACES.
*
01 W00-QNAME PIC X(48) VALUE SPACES.
01 W00-Q-PREFIX PIC X(17) VALUE
'CSQ4SAMP.MAILMGR.'.
01 W00-SYSTEM-REPLY-MODEL PIC X(26) VALUE
'SYSTEM.DEFAULT.MODEL.QUEUE'.
01 W00-SYSTEM-COMMAND-QUEUE PIC X(20) VALUE
'SYSTEM.COMMAND.INPUT'.
01 W00-SYSTEM-REPLY-INITIAL PIC X(10) VALUE
'CSQ4SAMP.*'.
*
01 W00-GET-WAIT-30SECS PIC S9(09) BINARY VALUE 30000.
01 W00-GET-WAIT-2SECS PIC S9(09) BINARY VALUE 2000.
*
01 W00-DEFINE-ALIAS-COMMAND.
05 PIC X(14) VALUE
'DEFINE QALIAS('.
05 W00-ALIAS-QNAME PIC X(48).
05 PIC X(63) VALUE
') LIKE(CSQ4SAMP.MAILMGR.ALIAS.TEM
- 'PLATE) TARGQ(CSQ4SAMP.MAILMGR.'.
05 W00-TARGQ-QNAME PIC X(08) VALUE SPACES.
05 PIC X VALUE
')'.
01 W00-DEFINE-REMOTE-COMMAND.
05 PIC X(16) VALUE
'DEFINE QREMOTE('.
05 W00-LOCAL-QNAME PIC X(48).
05 PIC X(63) VALUE
') PUT(ENABLED) DEFPRTY(2) DEFPSIS
- 'T(YES) RNAME(CSQ4SAMP.MAILMGR.'.
05 W00-REMOTE-QNAME PIC X(08) VALUE SPACES.
05 PIC X(10) VALUE
') RQMNAME('.
05 W00-REMOTE-QMGR PIC X(48) VALUE SPACES.
05 PIC X(08) VALUE
') XMITQ('.
05 W00-XMIT-QNAME PIC X(48) VALUE SPACES.
05 PIC X VALUE
')'.
01 W00-DEFINE-ALIAS-LENGTH PIC S9(09) BINARY.
01 W00-DEFINE-REMOTE-LENGTH PIC S9(09) BINARY.
01 W00-REPLY-LENGTH PIC S9(09) BINARY VALUE 100.
01 W00-COMMAND-REPLY.
05 W00-REPLY-NUM PIC X(08).
05 PIC X(26).
05 W00-RETURN PIC X(08).
05 PIC X(09).
05 W00-REASON PIC X(08).
05 PIC X(41).
01 FILLER REDEFINES W00-COMMAND-REPLY.
05 PIC X(34).
05 W00-RETURN-NUM PIC 9(08).
05 PIC X(09).
05 W00-REASON-NUM PIC 9(08).
05 PIC X(41).
01 W00-CREATE-WORKED PIC X.
01 W00-DATA-LENGTH PIC S9(09) BINARY.
*
* The following copy book contains messages that will be
* displayed to the user
*
COPY CSQ4VD0.
*
* ISPF definitions used in this program
*
COPY CSQ4VD1.
*
01 W01-ALIAS PIC X(08) VALUE
'(ALIAS)'.
01 W01-CMDMSG1 PIC X(09) VALUE
'(CMDMSG1)'.
01 W01-CMDMSG2 PIC X(09) VALUE
'(CMDMSG2)'.
01 W01-PANEL5 PIC X(08) VALUE
'CSQ4VDP5'.
01 W01-USERQ PIC X(08) VALUE
'(USERQ)'.
*
* ISPF variable definitions used in this program
*
COPY CSQ4VD2.
*
01 ALIAS PIC X(08) VALUE SPACES.
01 CMDMSG1 PIC X(79) VALUE SPACES.
01 CMDMSG2 PIC X(79) VALUE SPACES.
01 QMGR PIC X(48) VALUE SPACES.
01 USERQ PIC X(08) VALUE SPACES.
*
* W03 - API fields
*
01 W03-OPTIONS PIC S9(9) BINARY VALUE ZERO.
01 W03-HOBJ PIC S9(9) BINARY VALUE ZERO.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV SUPPRESS.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV SUPPRESS.
01 MQM-PUT-MESSAGE-OPTIONS.
COPY CMQPMOV SUPPRESS.
01 MQM-GET-MESSAGE-OPTIONS.
COPY CMQGMOV SUPPRESS.
*
* Copy book of constants (for filling in the control blocks)
* and return codes (for testing the result of a call)
*
01 CMQV.
COPY CMQV SUPPRESS.
EJECT
* ------------------------------------------------------------- *
LINKAGE SECTION.
* ------------------------------------------------------------- *
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section initializes the ISPF variables and then displays,*
* in a loop, the create nickname panel. Once the user has *
* entered data a check is made to validate that the nickname *
* does not already exist. If it does not exist it *
* will be created by sending a message to the system command *
* server queue. *
* *
* Errors are reported to the user. The program terminates when *
* a non-zero return code is returned by ISPF. *
* *
* ------------------------------------------------------------- *
*
* Define the variables to ISPF
* - this also copies current values into the program
* of those variables already known to ISPF
*
CALL 'ISPLINK' USING VD1-VDEFINE W01-ALIAS ALIAS
VD1-CHAR VD1-LENGTH8 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-CMDMSG1 CMDMSG1
VD1-CHAR VD1-LENGTH79 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-CMDMSG2 CMDMSG2
VD1-CHAR VD1-LENGTH79 .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-QMGR QMGR
VD1-CHAR VD1-LENGTH48 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-USERQ USERQ
VD1-CHAR VD1-LENGTH8 .
*
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HCONN HCONN
VD1-CHAR VD1-LENGTH4 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HOBJ HOBJ
VD1-CHAR VD1-LENGTH4 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-MSG MSG
VD1-CHAR VD1-LENGTH60 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-SUBSYS SUBSYS
VD1-CHAR VD1-LENGTH48 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-USERID USERID
VD1-CHAR VD1-LENGTH8 VD1-COPY .
*
* Update the relevant screen fields. If an error occurred
* it is recorded in MSG
*
MOVE SPACES TO MSG.
MOVE SPACES TO CMDMSG1.
MOVE SPACES TO CMDMSG2.
*
CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL5.
*
* Loop from here to END-PERFORM until the PF3 key is pressed
* or until an ISPF error occurs
*
PERFORM WITH TEST BEFORE UNTIL RETURN-CODE NOT = ZERO
*
MOVE SPACES TO MSG
MOVE SPACES TO CMDMSG1
MOVE SPACES TO CMDMSG2
*
PERFORM VALIDATE-USER-ENTRY
IF MSG = SPACES THEN
PERFORM CREATE-NICKNAME
END-IF
*
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
CALL 'ISPLINK' USING VD1-VPUT W01-CMDMSG1
CALL 'ISPLINK' USING VD1-VPUT W01-CMDMSG2
*
CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL5
*
END-PERFORM.
*
A-MAIN-EXIT.
*
* Return to ISPF
*
STOP RUN.
EJECT
*
* ------------------------------------------------------------- *
VALIDATE-USER-ENTRY SECTION.
* ------------------------------------------------------------- *
* *
* This section validates that both alias and user mail queue *
* names have been entered. *
* *
* ------------------------------------------------------------ *
*
IF ((ALIAS = SPACES) OR (ALIAS = LOW-VALUES)) THEN
MOVE VD0-MESSAGE-10 TO MSG
ELSE
MOVE SPACES TO W00-NICKNAME W00-VALIDATE
UNSTRING ALIAS DELIMITED BY ALL SPACE
INTO W00-NICKNAME W00-VALIDATE
IF ((W00-NICKNAME = SPACES) OR
(W00-VALIDATE NOT = SPACE))
MOVE VD0-MESSAGE-10 TO MSG
ELSE
IF ((USERQ = SPACES) OR
(USERQ = LOW-VALUES)) THEN
MOVE VD0-MESSAGE-11 TO MSG
ELSE
MOVE SPACES TO W00-USERQ W00-VALIDATE
UNSTRING USERQ DELIMITED BY ALL SPACE
INTO W00-USERQ W00-VALIDATE
IF ((W00-NICKNAME = SPACES) OR
(W00-VALIDATE NOT = SPACE))
MOVE VD0-MESSAGE-11 TO MSG
END-IF
END-IF
END-IF
END-IF.
*
VALIDATE-USER-ENTRY-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
SET-UP-NICKNAME-FIELDS SECTION.
* ------------------------------------------------------------- *
* *
* This section puts the information from ISPF variables *
* into the program variables to be used for nickname *
* checking and creation. *
* *
* ------------------------------------------------------------ *
*
MOVE USERQ TO W00-TARGQ-QNAME
W00-REMOTE-QNAME.
MOVE QMGR TO W00-REMOTE-QMGR
W00-XMIT-QNAME.
*
MOVE SPACES TO W00-QNAME.
STRING W00-Q-PREFIX USERID '.' ALIAS
DELIMITED BY SPACES
INTO W00-QNAME.
*
MOVE W00-QNAME TO W00-ALIAS-QNAME
W00-LOCAL-QNAME.
*
*
SET-UP-NICKNAME-FIELDS-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-NICKNAME SECTION.
* ------------------------------------------------------------- *
* *
* This section checks whether the nickname to be created *
* already exists, if it does the program returns to the *
* calling section. Otherwise a nickname will be created. *
* *
* If the target queue is on the local queue manager, an alias *
* queue is created by performing CREATE-ALIAS-QUEUE. If the *
* target queue is on another queue manager, a remote queue *
* is created by performing CREATE-REMOTE-QUEUE. *
* *
* Error messages are set by performed sections and displayed *
* by the performing section. *
* *
* ------------------------------------------------------------ *
*
PERFORM SET-UP-NICKNAME-FIELDS.
*
PERFORM CHECK-NICKNAME.
*
EVALUATE TRUE
WHEN MSG NOT = SPACES
* we have an error - so report it
CONTINUE
* we have no error - so lets do the processing
WHEN QMGR = SPACES
WHEN QMGR = LOW-VALUES
PERFORM CREATE-ALIAS-QUEUE
*
WHEN OTHER
IF (QMGR NOT = SUBSYS)
PERFORM CREATE-REMOTE-QUEUE
ELSE
PERFORM CREATE-ALIAS-QUEUE
END-IF
*
END-EVALUATE.
*
CREATE-NICKNAME-EXIT.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CHECK-NICKNAME SECTION.
* ------------------------------------------------------------- *
* *
* This section checks whether a nickname exists by trying to *
* open the queue corresponding to the nickname for inquiry. *
* *
* If the open fails for unknown object name the nickname does *
* not exist (so no error message is set). If the open succeeds *
* or fails for any other reason an error message is set for *
* display to the user by the calling section. If the *
* queue was opened it is closed. *
* *
* ------------------------------------------------------------ *
*
* Set up the MQSeries API control blocks.
* Apart from the following values, all other values in the
* control blocks will be set to their default values
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-QNAME TO MQOD-OBJECTNAME.
*
* W03-OPTIONS is set to open the queue for INQUIRE
* NOTE: The open option is irrelevant to this
* program. The open is only used to
* validate if the nickname already
* exists
*
MOVE MQOO-INQUIRE TO W03-OPTIONS.
*
* Open the queue
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
W03-HOBJ
COMPCODE
REASON.
*
* Test the output of the open call.
*
* If the open succeeds, the queue already exists. Move an
* error message to the panel, close the queue.
*
* If the open fails and the reason is not UNKNOWN-OBJECT-NAME
* move an error message showing the completion and reason codes
* to the panel.
*
* If the open fails with UNKNOWN-OBJECT-NAME, set the message
* to blanks
*
IF COMPCODE = MQCC-OK THEN
MOVE VD0-MESSAGE-12 TO MSG
CALL 'MQCLOSE' USING HCONN
W03-HOBJ
MQCO-NONE
COMPCODE
REASON
ELSE
IF (REASON NOT = MQRC-UNKNOWN-OBJECT-NAME) THEN
MOVE 'OPEN NICKQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
ELSE
MOVE SPACES TO MSG
END-IF
END-IF.
*
CHECK-NICKNAME-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-REMOTE-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section creates a remote queue by sending a command to *
* the queue manager system command input queue. A temporary *
* dynamic queue is created to receive the command server *
* responses and these responses are checked to determine if *
* the queue has been successfully created. *
* Status and error messages are prepared for display by the *
* calling section. *
* *
* ------------------------------------------------------------ *
*
PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
*
* Test the output of the open call. If the call failed,
* build an error message showing the completion code and
* reason, and return to the performing section
* to allow it to be displayed
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN TEMPQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO CREATE-REMOTE-QUEUE-EXIT
END-IF.
*
* Save the queue name and also place it in the REPLYTOQ field.
* Use the REQUEST message type to ensure that the Command
* Server sends back all reply messages. The define remote queue
* message is then written to the SYSTEM-COMMAND-INPUT queue to
* be processed
*
MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ.
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
*
MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS.
*
MOVE LENGTH OF W00-DEFINE-REMOTE-COMMAND
TO W00-DEFINE-REMOTE-LENGTH.
*
* Put the define remote command
*
CALL 'MQPUT1' USING HCONN
MQOD
MQMD
MQPMO
W00-DEFINE-REMOTE-LENGTH
W00-DEFINE-REMOTE-COMMAND
COMPCODE
REASON.
*
* If the compcode is not OK after the PUT1 request
* display an error message and return
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'MQPUT1-R ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
ELSE
PERFORM GET-COMMAND-SERVER-RESP
*
* The response messages are set in the function, no
* testing is done after return
*
END-IF.
*
PERFORM CLOSE-TEMP-DYNAMIC-QUEUE.
*
CREATE-REMOTE-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-ALIAS-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section creates an alias queue by sending a command to *
* the queue manager system command input queue. A temporary *
* dynamic queue is created to receive the command server *
* responses and these responses are checked to determine if *
* the queue has been successfully created. *
* Status and error messages are prepared for display by the *
* performing section. *
* *
* ------------------------------------------------------------ *
*
PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
*
* Test the output of the open call. If the call failed,
* build an error message showing the completion code and
* reason, and return to the performing section
* to allow it to be displayed
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN TEMPQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO CREATE-ALIAS-QUEUE-EXIT
END-IF.
*
* Save the queue name and also place it in the REPLYTOQ field.
* Use the REQUEST message type to ensure that the Command
* Server sends back all reply messages. The define alias queue
* message is then written to the SYSTEM-COMMAND-INPUT queue to
* be processed
*
MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ.
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
*
MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS.
*
MOVE LENGTH OF W00-DEFINE-ALIAS-COMMAND
TO W00-DEFINE-ALIAS-LENGTH.
*
* Put the define alias command
*
CALL 'MQPUT1' USING HCONN
MQOD
MQMD
MQPMO
W00-DEFINE-ALIAS-LENGTH
W00-DEFINE-ALIAS-COMMAND
COMPCODE
REASON.
*
* If the compcode is not OK after the PUT1 request
* display an error message and return
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'MQPUT1-A ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
ELSE
PERFORM GET-COMMAND-SERVER-RESP
*
* The response messages are set in the function, no
* testing is done after return
*
END-IF.
*
PERFORM CLOSE-TEMP-DYNAMIC-QUEUE.
*
CREATE-ALIAS-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-TEMP-DYNAMIC-QUEUE SECTION.
* ------------------------------------------------------------- *
* This section creates a temporary dynamic queue using a *
* model queue. *
* *
* ------------------------------------------------------------ *
*
* Initialize the Object Descriptor (MQOD) control block.
* (The remaining fields are already initialized)
*
* OBJECTNAME - Contains the name of the model queue that is
* to be used to create the temporary dynamic
* queue name.
* DYNAMICQNAME - Contains the characters that the queue name
* is to begin with.
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-REPLY-MODEL TO MQOD-OBJECTNAME.
MOVE W00-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME.
MOVE ZERO TO W03-HOBJ.
MOVE MQOO-INPUT-AS-Q-DEF TO W03-OPTIONS.
*
* Open the queue and, therefore, create the queue
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
W03-HOBJ
COMPCODE
REASON.
*
CREATE-TEMP-DYNAMIC-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
GET-COMMAND-SERVER-RESP SECTION.
* ------------------------------------------------------------- *
* *
* This section gets the command server responses in a loop *
* until the right message (CSQN205I) arrives or an error *
* occurs. *
* When the message is received it is checked to see if the *
* queue creation was successful - if it was an appropriate *
* message is prepared for display by the calling section, *
* otherwise GET-ERROR-DETAILS is called to get the reasons *
* for the error. *
* If any errors occur, appropriate messages are prepared for *
* display by the calling section. *
* *
* ------------------------------------------------------------ *
*
* Set up the options for the get-wait call
*
MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
ADD MQGMO-WAIT TO MQGMO-OPTIONS.
ADD MQGMO-NO-SYNCPOINT TO MQGMO-OPTIONS.
*
MOVE W00-GET-WAIT-30SECS TO MQGMO-WAITINTERVAL.
*
* Loop around until an error occurs or until the right
* message arrives
*
MOVE SPACES TO W00-CREATE-WORKED
PERFORM WITH TEST AFTER UNTIL ((COMPCODE NOT = MQCC-OK) OR
(W00-CREATE-WORKED NOT = SPACES))
*
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQCI-NONE TO MQMD-CORRELID
MOVE SPACES TO W00-COMMAND-REPLY
*
CALL 'MQGET' USING HCONN
W03-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W00-DATA-LENGTH
COMPCODE
REASON
*
* If the compcode is not OK after the get, and the reason
* is not NO-MSG-AVAILABLE, build an error message.
* If the reason is NO-MSG-AVAILABLE just exit the loop.
* Otherwise each message is checked to locate the command
* server reply (CSQN205I). When this is located the return
* code is checked. Depending on the return code received
* the create worked flag is set. If the create failed,
* the error details are retrieved and built for display
*
IF (COMPCODE NOT = MQCC-OK) THEN
IF (REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
MOVE 'MQGET ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
MOVE 'N' TO W00-CREATE-WORKED
END-IF
ELSE
IF W00-REPLY-NUM = 'CSQN205I' THEN
* Validate the response from the create queue section.
* Move either a 'success' or 'fail' message to the panel
* dependant on W00-CREATE-WORKED
*
IF W00-RETURN = '00000000' THEN
MOVE 'Y' TO W00-CREATE-WORKED
MOVE VD0-MESSAGE-14 TO MSG
ELSE
MOVE 'N' TO W00-CREATE-WORKED
MOVE VD0-MESSAGE-13 TO MSG
*
* The next two messages should contain
* details of the failure. GET-ERROR-DETAILS
* puts them in the screen message fields
*
PERFORM GET-ERROR-DETAILS
*
END-IF
END-IF
END-IF
*
END-PERFORM.
*
IF W00-CREATE-WORKED = SPACES THEN
MOVE VD0-MESSAGE-26 TO MSG
END-IF.
*
GET-COMMAND-SERVER-RESP-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
CLOSE-TEMP-DYNAMIC-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section closes, and thus deletes, the temporary *
* dynamic queue. *
* *
* ------------------------------------------------------------ *
*
*
* Close the reply queue and purge it
*
CALL 'MQCLOSE' USING HCONN
W03-HOBJ
MQCO-NONE
COMPCODE
REASON.
*
CLOSE-TEMP-DYNAMIC-QUEUE-EXIT.
*
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
GET-ERROR-DETAILS SECTION.
* ------------------------------------------------------------- *
* *
* This section get two messages from the queue and puts the *
* message data into message fields for display by the calling *
* section. If errors occur in getting these messages, no *
* additional data will be available to the user. No error *
* checking is done on the calls. *
* *
* ------------------------------------------------------------ *
*
* Get the next message on the queue which should
* contain a displayable message of what went wrong
*
MOVE W00-GET-WAIT-2SECS TO MQGMO-WAITINTERVAL.
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
MOVE SPACES TO W00-COMMAND-REPLY.
*
CALL 'MQGET' USING HCONN
W03-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W00-DATA-LENGTH
COMPCODE
REASON.
*
MOVE W00-COMMAND-REPLY TO CMDMSG1.
*
* Get the next message on the queue which should
* contain another displayable message of what went wrong
*
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
MOVE SPACES TO W00-COMMAND-REPLY.
*
CALL 'MQGET' USING HCONN
W03-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W00-DATA-LENGTH
COMPCODE
REASON.
*
MOVE W00-COMMAND-REPLY TO CMDMSG2.
*
*
GET-ERROR-DETAILS-EXIT.
*
*
* Return to performing section
*
EXIT.
*
* ---------------------------------------------------------------
* End of program
* ---------------------------------------------------------------
¤ Dauer der Verarbeitung: 0.69 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
