|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4TVH1.
*REMARKS
*****************************************************************
* @START_COPYRIGHT@ *
* Statement: Licensed Materials - Property of IBM *
* *
* 5695-137 *
* (C) Copyright IBM Corporation. 1993, 1997 *
* *
* Status: Version 1 Release 2 *
* @END_COPYRIGHT@ *
* ************************************************************* *
* *
* Module Name : CSQ4TVH1 *
* *
* Environment : MVS TSO/ISPF; COBOL II *
* *
* Function : This program validates the queue and queue *
* manager names required for the Message *
* Handler sample program. *
* See IBM message Queue Manager MVS/ESA *
* Application Programming Reference, document *
* number SC33-1212, for further details. *
* *
* Description : This program displays panel CSQ4CHP1 and *
* validates the queue and queue manager names *
* entered. When both are valid, program *
* CSQ4TVH2 is initiated. *
* *
* *
*****************************************************************
* *
* Program Logic *
* *
*---------------------------------------------------------------*
* *
* A-MAIN SECTION *
* -------------- *
* *
* initialize variables used by ISPF *
* blank panel message line *
* loop displaying panel until END command *
* connect to queue manager *
* if connect was successful *
* open the queue *
* if open was successful *
* call CSQ4TVH2 passing MQ handles via ISPF *
* get the panel message line from ISPF *
* close the queue *
* endif *
* disconnect from queue manager *
* endif *
* endloop *
* exit program *
* *
*---------------------------------------------------------------*
* *
* CONNECT-TO-QMGR SECTION *
* ----------------------- *
* *
* if queue manager name is undefined *
* blank the queue manager name *
* endif *
* call MQCONN with queue manager name *
* if connection unsuccessful *
* display an appropriate error message for failure *
* else *
* put the new connection handle to ISPF *
* if queue manager name blank *
* get the default queue manager name *
* endif *
* if a queue manager name is available *
* put the queue manager name to ISPF *
* else *
* display error message *
* endif *
* endif *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* DISCONNECT-QMGR SECTION *
* ----------------------- *
* *
* call MQDISC *
* if call successful *
* put new connection handle to ISPF *
* else *
* display error message *
* endif *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* GET-DEFAULT-QMGRNAME SECTION *
* ---------------------------- *
* *
* set open options for queue manager *
* open queue manager (MQOPEN) for inquire *
* if open failed *
* display error message *
* exit from section *
* endif *
* call MQINQ for queue manager name *
* if call successful *
* copy the queue manager name from MQINQ variable *
* endif *
* close the queue manager (MQCLOSE) *
* exit from section *
* *
*---------------------------------------------------------------*
* INQUIRE-Q SECITON *
* ----------------- *
* *
* set open options for queue *
* open queue manager (MQOPEN) for inquire *
* if open failed *
* display error message *
* exit from section *
* endif *
* call MQINQ for queue type and queue definition type *
* if call successful *
* if queue is not local *
* display error message *
* exit from section *
* endif *
* else if reason code indicates queue is not local *
* display error message *
* exit from section *
* else *
* display error message *
* exit from section *
* endif *
* close the queue manager (MQCLOSE) *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* CLOSE-Q SECTION *
* --------------- *
* *
* call MQCLOSE *
* if call successful *
* put new object handle to ISPF *
* else *
* display error message *
* endif *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* OPEN-Q SECTION *
* -------------- *
* *
* inquire on queue name *
* if queue is local *
* set open options for queue *
* open queue (MQOPEN) for inquire, browse, exclusive *
* input and to save all context information *
* if open successful *
* put the queue name to ISPF *
* put the new object handle to ISPF *
* else *
* display an error message *
* endif *
* exit from section *
* else *
* exit from section *
* endif *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* ERROR-MESSAGE SECTION *
* --------------------- *
* *
* copy error message into panel message line variable *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* PRINT-MESSAGE SECTION *
* --------------------- *
* *
* copy message into panel message line variable *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* ISPF-INIT SECTION *
* ----------------- *
* *
* call VDEFINE for all variables to go into ISPF *
* shared variable pool *
* exit from section *
* *
* ************************************************************* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-ERRORMSG PIC X(40) VALUE SPACES.
01 W00-RETCODE PIC S9(9) BINARY.
*
* W01 - ISPF Variables
*
01 W01-QMGRNAME PIC X(48) VALUE SPACES.
01 W01-QNAME PIC X(48) VALUE SPACES.
01 W01-HCONN PIC S9(09) BINARY.
01 W01-HOBJ PIC S9(09) BINARY.
01 W01-MESSAGE PIC X(79) VALUE SPACES.
*
* W02 - MQAPI Variables
*
01 W02-COMPCODE PIC S9(9) BINARY.
01 W02-COMPCODE-CHAR PIC Z(1)9 VALUE SPACES.
01 W02-REASON PIC S9(9) BINARY.
01 W02-REASON-CHAR PIC Z(4)9 VALUE SPACES.
01 W02-QMGRHOBJ PIC S9(09) BINARY.
01 W02-SELECTORS-TABLE.
05 W02-SELECTORS PIC S9(09) BINARY OCCURS 2 TIMES.
01 W02-SELECTORCOUNT PIC S9(09) BINARY.
01 W02-INTATTRS-TABLE.
05 W02-INTATTRS PIC S9(09) BINARY OCCURS 2 TIMES.
01 W02-INTATTRCOUNT PIC S9(09) BINARY.
01 W02-CHARATTRS PIC X(48) VALUE SPACES.
01 W02-CHARATTRLENGTH PIC S9(09) BINARY.
01 W02-OPENOPTIONS PIC S9(09) BINARY.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV.
*
* MQV contains constants (for filling in the control blocks)
* and return codes (for testing the result of a call)
*
01 MQM-CONSTANTS.
COPY CMQV SUPPRESS.
*
* ISPFLINK Strings
*
01 IDISPLAY PIC X(8) VALUE 'DISPLAY '.
01 ISELECT PIC X(8) VALUE 'SELECT '.
01 ISHARED PIC X(8) VALUE 'SHARED '.
01 IVDEFINE PIC X(8) VALUE 'VDEFINE '.
01 IVPUT PIC X(8) VALUE 'VPUT '.
01 IVGET PIC X(8) VALUE 'VGET '.
01 ICHAR PIC X(8) VALUE 'CHAR '.
01 IFIXED PIC X(8) VALUE 'FIXED '.
01 IPANEL1 PIC X(8) VALUE 'CSQ4CHP1'.
01 I4 PIC 9(6) VALUE 4 COMP.
01 I13 PIC 9(6) VALUE 13 COMP.
01 I48 PIC 9(6) VALUE 48 COMP.
01 I79 PIC 9(6) VALUE 79 COMP.
01 IPROG2 PIC X(13) VALUE 'PGM(CSQ4TVH2)'.
01 IMESSAGE PIC X(8) VALUE 'MSG '.
01 IHOBJ PIC X(8) VALUE 'HOBJ '.
01 IHCONN PIC X(8) VALUE 'HCONN '.
01 IQNAME PIC X(8) VALUE 'QNAME '.
01 IQMGRNAME PIC X(8) VALUE 'QMGRNAME'.
*
* ------------------------------------------------------------- *
LINKAGE SECTION.
* ------------------------------------------------------------- *
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* Set up variables used with ISPF *
* *
PERFORM ISPF-INIT.
* *
* Blank ISPF panel message *
* *
MOVE SPACES TO W01-MESSAGE.
PERFORM PRINT-MESSAGE.
* *
* Loop until ready to quit the program *
* *
CALL 'ISPLINK' USING IDISPLAY IPANEL1.
PERFORM WITH TEST BEFORE UNTIL (RETURN-CODE = 8)
* *
* If connecting to the queue manager is successful *
* then try opening the queue. If the open is also *
* successful then call CSQ4TCH2 to display *
* all the messages on specified queue. *
* Close the queue and disconnect on finishing. *
* *
PERFORM CONNECT-TO-QMGR
IF (MQRC-NONE = W02-REASON) THEN
PERFORM OPEN-Q
IF (MQRC-NONE = W02-REASON) THEN
CALL 'ISPLINK' USING IVPUT IQMGRNAME ISHARED
CALL 'ISPLINK' USING IVPUT IQNAME ISHARED
CALL 'ISPLINK' USING ISELECT I13 IPROG2
CALL 'ISPLINK' USING IVGET IMESSAGE ISHARED
PERFORM CLOSE-Q
END-IF
PERFORM DISCONNECT-QMGR
END-IF
*
CALL 'ISPLINK' USING IDISPLAY IPANEL1
*
END-PERFORM.
*
A-MAIN-EXIT.
*
GOBACK.
EJECT
*
*---------------------------------------------------------------*
CONNECT-TO-QMGR SECTION.
*---------------------------------------------------------------*
* This section tries to connect to the specified queue manager. *
* If the connection is successful then the connection handle is *
* returned. *
* Upon failure an error message is displayed. *
*---------------------------------------------------------------*
*
* *
* Connect to the specified queue manager *
* *
CALL 'MQCONN' USING W01-QMGRNAME
W01-HCONN
W02-COMPCODE
W02-REASON.
*
* *
* If the connection was successful then add the connection *
* handle details to the ISPF shared variable pool. *
* If W01-QMGRNAME is blank then the GET-DEFAULT-QMGRNAME *
* section is called. *
* The queue manager name is then put into the ISPF shared *
* variable pool. *
* *
* If the connection failed then an appropriate error *
* is displayed. MQCC_WARNINGs can be ignored. *
* *
IF (MQCC-FAILED = W02-COMPCODE) THEN
*
EVALUATE TRUE
WHEN (MQRC-Q-MGR-NAME-ERROR = W02-REASON)
MOVE 'Queue manager name error.' TO W00-ERRORMSG
WHEN (MQRC-Q-MGR-NOT-AVAILABLE = W02-REASON)
MOVE 'Queue manager not available.'
TO W00-ERRORMSG
WHEN OTHER
MOVE 'Unable to connect to queue manager.'
TO W00-ERRORMSG
END-EVALUATE
PERFORM ERROR-MESSAGE
*
ELSE
*
MOVE MQRC-NONE TO W02-REASON
MOVE MQCC-OK TO W02-COMPCODE
CALL 'ISPLINK' USING IVPUT IHCONN ISHARED
*
IF (SPACES = W01-QMGRNAME) THEN
*
PERFORM GET-DEFAULT-QMGRNAME
IF (MQRC-NONE NOT = W02-REASON)
*
MOVE 'No queue manager name available.'
TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
*
END-IF
CALL 'ISPLINK' USING IVPUT IQMGRNAME ISHARED
*
END-IF.
*
CONNECT-TO-QMGR-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
DISCONNECT-QMGR SECTION.
*---------------------------------------------------------------*
* This section attempts to disconnect from the queue manager. *
* The connection handle is set by the MQDISC call and upon *
* failure an error message is displayed. *
*---------------------------------------------------------------*
*
CALL 'MQDISC' USING W01-HCONN
W02-COMPCODE
W02-REASON.
*
* *
* If the disconnect was successful then put the connection *
* handle into the ISPF shared variable pool *
* *
IF (MQCC-OK = W02-COMPCODE) THEN
CALL 'ISPLINK' USING IVPUT IHCONN ISHARED
ELSE
MOVE 'Disconnect from queue manager failed.'
TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
END-IF.
*
DISCONNECT-TO-QMGR-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
GET-DEFAULT-QMGRNAME SECTION.
*---------------------------------------------------------------*
* This section opens the queue manager and inquires on the *
* default queue manager name. *
*---------------------------------------------------------------*
*
MOVE 1 TO W02-SELECTORCOUNT.
MOVE 0 TO W02-INTATTRCOUNT.
MOVE MQ-Q-MGR-NAME-LENGTH TO W02-CHARATTRLENGTH.
* *
* Set the open options to inquire on a queue manager *
* *
MOVE MQOT-Q-MGR TO MQOD-OBJECTTYPE.
MOVE SPACES TO MQOD-OBJECTNAME.
MOVE MQOO-INQUIRE TO W02-OPENOPTIONS.
*
CALL 'MQOPEN' USING W01-HCONN
MQOD
W02-OPENOPTIONS
W02-QMGRHOBJ
W02-COMPCODE
W02-REASON.
* *
* If the open was unsuccessful then return the reason code *
* *
IF (MQCC-OK NOT = W02-COMPCODE) THEN
GO TO GET-DEFAULT-QMGRNAME-EXIT.
* *
* Set the inquire options to inquire on the queue *
* manager name and call MQINQ *
* *
MOVE MQCA-Q-MGR-NAME TO W02-SELECTORS(1).
*
CALL 'MQINQ' USING W01-HCONN
W02-QMGRHOBJ
W02-SELECTORCOUNT
W02-SELECTORS-TABLE
W02-INTATTRCOUNT
W02-INTATTRS-TABLE
W02-CHARATTRLENGTH
W02-CHARATTRS
W02-COMPCODE
W02-REASON.
* *
* If the inquire was successful then copy the default *
* queue manager name to variable passed to function. *
* *
IF (MQCC-OK = W02-COMPCODE) THEN
MOVE W02-CHARATTRS TO W01-QMGRNAME.
* *
* Close the queue manager *
* *
CALL 'MQCLOSE' USING W01-HCONN
W02-QMGRHOBJ
MQCO-NONE
W02-COMPCODE
W00-RETCODE.
*
GET-DEFAULT-QMGRNAME-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
INQUIRE-Q SECTION.
*---------------------------------------------------------------*
* This section opens the specified queue to inquire on the *
* queue and definition type. The definition type is required *
* to distinguish local queues from dynamic queues created when *
* a model queue is opened for inquiry. If the queue is unable *
* to be opened or the inquiry shows the queue is not a local *
* queue, an appropriate error message is issued. *
*---------------------------------------------------------------*
*
MOVE 2 TO W02-SELECTORCOUNT.
MOVE 2 TO W02-INTATTRCOUNT.
MOVE ZEROES TO W02-CHARATTRLENGTH.
* *
* Set the open options to inquire on the queue. *
* *
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W01-QNAME TO MQOD-OBJECTNAME.
MOVE MQOO-INQUIRE TO W02-OPENOPTIONS.
*
CALL 'MQOPEN' USING W01-HCONN
MQOD
W02-OPENOPTIONS
W02-QMGRHOBJ
W02-COMPCODE
W02-REASON.
* *
* If the open was unsuccessful, then issue an appropriate *
* error message and return the reason code. *
* *
IF (MQCC-OK NOT = W02-COMPCODE) THEN
MOVE 'Unable to open queue.'
TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
GO TO INQUIRE-Q-EXIT.
* *
* Set the inquire selectors for queue type and queue *
* definition type. *
* *
MOVE MQIA-Q-TYPE TO W02-SELECTORS(1).
MOVE MQIA-DEFINITION-TYPE TO W02-SELECTORS(2).
*
CALL 'MQINQ' USING W01-HCONN
W02-QMGRHOBJ
W02-SELECTORCOUNT
W02-SELECTORS-TABLE
W02-INTATTRCOUNT
W02-INTATTRS-TABLE
W02-CHARATTRLENGTH
W02-CHARATTRS
W02-COMPCODE
W02-REASON.
* *
* If the inquire was successful then check whether the *
* queue is local. If not, issue an error message and set *
* W02-REASON to a negative value for return to caller. *
* If the inquire is unsucessful, then determine whether *
* the reason for failure was because we inquired on an *
* attribute not applicable to local queues or some other *
* reason, and issue an appropriate error message. *
IF (MQRC-NONE = W02-REASON) THEN
IF ( (W02-INTATTRS(1) NOT = MQQT-LOCAL) OR
(W02-INTATTRS(2) NOT = MQQDT-PREDEFINED) ) THEN
MOVE 'Queue Name is not a local queue.'
TO W01-MESSAGE
PERFORM PRINT-MESSAGE
MOVE -1 TO W02-REASON
GO TO INQUIRE-Q-CLOSE
ELSE
GO TO INQUIRE-Q-CLOSE
END-IF
END-IF
IF (MQRC-SELECTOR-NOT-FOR-TYPE = W02-REASON) THEN
MOVE 'Queue Name is not a local queue.'
TO W01-MESSAGE
PERFORM PRINT-MESSAGE
MOVE -1 TO W02-REASON
GO TO INQUIRE-Q-CLOSE
ELSE
MOVE 'Unable to inquire whether queue is local.'
TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
MOVE -1 TO W02-REASON
GO TO INQUIRE-Q-CLOSE
END-IF.
* *
* Close the queue. *
* *
*
INQUIRE-Q-CLOSE.
*
CALL 'MQCLOSE' USING W01-HCONN
W02-QMGRHOBJ
MQCO-NONE
W02-COMPCODE
W00-RETCODE.
*
INQUIRE-Q-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
CLOSE-Q SECTION.
*---------------------------------------------------------------*
* This section closes the specified queue. *
* If the close is successful then the updated object handle is *
* replaced in the ISPF shared variable pool. *
* A failure will cause an error message to be displayed. *
*---------------------------------------------------------------*
*
CALL 'MQCLOSE' USING W01-HCONN
W01-HOBJ
MQCO-NONE
W02-COMPCODE
W02-REASON.
*
IF (MQCC-OK = W02-COMPCODE) THEN
CALL 'ISPLINK' USING IVPUT IHOBJ ISHARED
ELSE
MOVE 'Failed when closing queue.' TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
END-IF.
*
CLOSE-Q-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
OPEN-Q SECTION.
*---------------------------------------------------------------*
* This section inquires on the specified queue to verify that *
* it is a local queue. If so, the section tries to open the *
* queue and return the object handle created. *
* If successful then the queue name and new object handle will *
* be put into the ISPF shared variable pool. *
* An error will cause an appropriate message to be displayed. *
*---------------------------------------------------------------*
*
* *
*
PERFORM INQUIRE-Q.
IF (MQRC-NONE NOT = W02-REASON) THEN
GO TO OPEN-Q-EXIT.
* *
* Set MQOPEN options for a queue and set the queue name *
* *
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W01-QNAME TO MQOD-OBJECTNAME.
*
* *
* The specified queue is set for inquire, browse and *
* exclusive input. The context of any message taken *
* from the queue must also be available if that *
* message is to be forwarded to another queue later *
* on. *
* *
COMPUTE W02-OPENOPTIONS = MQOO-INQUIRE +
MQOO-BROWSE +
MQOO-INPUT-EXCLUSIVE +
MQOO-SAVE-ALL-CONTEXT.
*
CALL 'MQOPEN' USING W01-HCONN
MQOD
W02-OPENOPTIONS
W01-HOBJ
W02-COMPCODE
W02-REASON.
*
IF (MQCC-OK = W02-COMPCODE) THEN
CALL 'ISPLINK' USING IVPUT IHOBJ ISHARED
CALL 'ISPLINK' USING IVPUT IQNAME ISHARED
ELSE
MOVE 'Unable to open queue.' TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
END-IF.
*
OPEN-Q-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
ERROR-MESSAGE SECTION.
*---------------------------------------------------------------*
* This section puts an error message to the ISPF panel. *
* The message consists of some text message, a completion code *
* and a reason code. *
*---------------------------------------------------------------*
*
MOVE W02-COMPCODE TO W02-COMPCODE-CHAR.
MOVE W02-REASON TO W02-REASON-CHAR.
*
STRING W00-ERRORMSG, ' CompCode: ',
W02-COMPCODE-CHAR, ' Reason: ',
W02-REASON-CHAR, ' '
DELIMITED BY SIZE INTO W01-MESSAGE.
*
PERFORM PRINT-MESSAGE.
*
ERROR-MESSAGE-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
PRINT-MESSAGE SECTION.
*---------------------------------------------------------------*
* This section places a message onto the ISPF panel. *
*---------------------------------------------------------------*
*
CALL 'ISPLINK' USING IVPUT IMESSAGE ISHARED.
*
PRINT-MESSAGE-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
ISPF-INIT SECTION.
*---------------------------------------------------------------*
* This section declares all variables which are to be stored *
* in the ISPF shared variable pool. These variables are used *
* with the ISPF panels or passed to the programs called. *
*---------------------------------------------------------------*
*
CALL 'ISPLINK' USING IVDEFINE
IQMGRNAME W01-QMGRNAME ICHAR I48.
CALL 'ISPLINK' USING IVDEFINE
IQNAME W01-QNAME ICHAR I48.
CALL 'ISPLINK' USING IVDEFINE
IHCONN W01-HCONN IFIXED I4.
CALL 'ISPLINK' USING IVDEFINE
IHOBJ W01-HOBJ IFIXED I4.
CALL 'ISPLINK' USING IVDEFINE
IMESSAGE W01-MESSAGE ICHAR I79.
*
ISPF-INIT-EXIT.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
* End of program *
* ------------------------------------------------------------- *
¤ Dauer der Verarbeitung: 0.43 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.
|
