The following program extracts all the items of a TS queue and write them to a flat file. The program has been tested using Dell Enterprise COBOL and executed in Dell TPE.
The same program can be compiled and executed using any available re-hosting platform for LUW. Please note that the program uses native Unix/Linux C APIs to write the data to a flat file so it cannot run as is on a Mainframe computer.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | *
* Author: Santix, http://www.italianscool.com
*
* Exporting TS QUEUE data to a flat file
*
IDENTIFICATION DIVISION.
*
PROGRAM-ID. EXPQUEUE.
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 WS-IDX PIC S9(4) COMP.
01 WS-NUMITEMS PIC S9(4) COMP.
01 WS-NUMITEMS-DISP PIC S9(4).
01 WS-LENGTH PIC S9(4) COMP.
01 WS-EIBRESP PIC S9(4) COMP.
01 WS-EIBRESP-DISP PIC S9(4).
01 WS-BUFFER.
03 WS-TRANSACTION PIC X(4).
03 WS-TSQUEUE PIC X(8).
01 WS-QDATA PIC X(32000).
01 WS-MSG.
03 WS-MSG-LINE-1 PIC X(79).
03 WS-MSG-LINE-2 PIC X(79).
03 WS-MSG-LINE-3 PIC X(79).
*
01 WS-SEPARATED-LOGFILE PIC X(256).
01 WS-LOG-FILENAME-PTR POINTER.
01 WS-FILE-IO-FUNCTION.
03 FILLER PIC X.
88 WS-IO-FUNCTION-WRITE VALUE "w".
88 WS-IO-FUNCTION-READ VALUE "r".
88 WS-IO-FUNCTION-APPEND VALUE "a".
03 FILLER PIC X VALUE LOW-VALUE.
01 WS-FILE-IO-RC PIC S9(9) COMP-5.
01 WS-GREGORN.
03 WS-DT-YEAR PIC X(4).
03 WS-DT-MONTH PIC X(2).
03 WS-DT-DAY PIC X(2).
03 WS-TM-HOUR PIC X(2).
03 WS-TM-MINUTES PIC X(2).
03 WS-TM-SECONDS PIC X(2).
03 WS-TM-MSECONDS PIC X(3).
01 WS-LILIAN PIC S9(9) COMP.
01 WS-XSECONDS PIC S9(18) COMP.
01 WS-FC PIC X(12).
01 WS-LOG-TMS.
03 WS-DT-YEAR PIC X(4).
03 WS-DT-MONTH PIC X(2).
03 WS-DT-DAY PIC X(2).
03 FILLER PIC X VALUE "_".
03 WS-TM-HOUR PIC X(2).
03 WS-TM-MINUTES PIC X(2).
03 WS-TM-SECONDS PIC X(2).
*
LINKAGE SECTION.
*
01 DFHCOMMAREA PIC X(32000).
01 LK-LOG-FILENAME-PTR PIC X(8).
*
PROCEDURE DIVISION.
*
MAIN-SECTION.
MOVE SPACE TO WS-MSG
MOVE 12 TO WS-LENGTH
EXEC CICS
RECEIVE INTO(WS-BUFFER)
LENGTH(WS-LENGTH)
NOHANDLE
END-EXEC
DISPLAY "------------------------------------------"
DISPLAY "WS-LENGTH=" WS-LENGTH
DISPLAY "WS-TSQUEUE=" WS-TSQUEUE
DISPLAY "------------------------------------------"
IF WS-LENGTH <=4 OR WS-TSQUEUE = SPACE
MOVE "USAGE: EXQ "
TO WS-MSG
PERFORM EXIT-OK
END-IF
INSPECT WS-TSQUEUE REPLACING ALL LOW-VALUE BY SPACE
EXEC CICS
INQUIRE TSQUEUE(WS-TSQUEUE)
NUMITEMS(WS-NUMITEMS)
RESP(WS-EIBRESP)
NOHANDLE
END-EXEC
MOVE WS-EIBRESP TO WS-EIBRESP-DISP
MOVE WS-NUMITEMS TO WS-NUMITEMS-DISP
STRING "QUEUE(" WS-TSQUEUE ")_EIBRESP=" WS-EIBRESP-DISP
"_NUMITEMS=" WS-NUMITEMS-DISP
DELIMITED BY SIZE
INTO WS-MSG-LINE-1
IF WS-EIBRESP NOT= ZERO
OR WS-NUMITEMS = ZERO
PERFORM EXIT-OK
END-IF
*
CALL 'CEELOCT' USING WS-LILIAN
WS-XSECONDS
WS-GREGORN
WS-FC
MOVE CORR WS-GREGORN TO WS-LOG-TMS
STRING
"/tmp/CEBR_" DELIMITED BY SIZE
WS-TSQUEUE DELIMITED BY SPACE
"_" WS-LOG-TMS ".txt"
X'00' DELIMITED BY SIZE
INTO WS-SEPARATED-LOGFILE
SET WS-IO-FUNCTION-WRITE TO TRUE
CALL "fopen" USING WS-SEPARATED-LOGFILE
WS-FILE-IO-FUNCTION
GIVING WS-LOG-FILENAME-PTR
IF WS-LOG-FILENAME-PTR = NULL
STRING "OPEN_LOG_ERROR:_" DELIMITED BY SIZE
WS-SEPARATED-LOGFILE DELIMITED BY LOW-VALUE
INTO WS-MSG-LINE-2
PERFORM EXIT-OK
END-IF
*
PERFORM VARYING WS-IDX FROM 1 BY 1
UNTIL WS-IDX > WS-NUMITEMS
MOVE 32000 TO WS-LENGTH
EXEC CICS
READQ TS QUEUE(WS-TSQUEUE)
INTO(WS-QDATA)
LENGTH(WS-LENGTH)
ITEM(WS-IDX)
RESP(WS-EIBRESP)
NOHANDLE
END-EXEC
IF WS-EIBRESP NOT= ZERO
AND WS-EIBRESP NOT= 22
CALL "fclose" USING LK-LOG-FILENAME-PTR
MOVE WS-EIBRESP TO WS-EIBRESP-DISP
STRING "READQ_EIBRESP=" WS-EIBRESP-DISP
DELIMITED BY SIZE
INTO WS-MSG-LINE-2
PERFORM EXIT-OK
END-IF
SET ADDRESS OF LK-LOG-FILENAME-PTR
TO WS-LOG-FILENAME-PTR
ADD 1 TO WS-LENGTH
IF WS-LENGTH > 32000
MOVE 32000 TO WS-LENGTH
END-IF
INSPECT WS-QDATA(1:WS-LENGTH) REPLACING
ALL LOW-VALUE BY SPACE
INSPECT WS-QDATA(1:WS-LENGTH) REPLACING
ALL HIGH-VALUE BY SPACE
MOVE x'0A' TO WS-QDATA(WS-LENGTH:1)
CALL "fwrite" USING WS-QDATA
BY VALUE LENGTH OF WS-QDATA(1:WS-LENGTH)
BY VALUE 1
BY REFERENCE LK-LOG-FILENAME-PTR
GIVING WS-FILE-IO-RC
IF WS-FILE-IO-RC NOT= 1
CALL "fclose" USING LK-LOG-FILENAME-PTR
STRING "WRITE_LOG_ERROR:_" DELIMITED BY SIZE
WS-SEPARATED-LOGFILE DELIMITED BY LOW-VALUE
INTO WS-MSG-LINE-2
PERFORM EXIT-OK
END-IF
END-PERFORM
*
CALL "fclose" USING LK-LOG-FILENAME-PTR
STRING "DATA_TO:_" DELIMITED BY SIZE
WS-SEPARATED-LOGFILE DELIMITED BY LOW-VALUE
INTO WS-MSG-LINE-2
PERFORM EXIT-OK
*
.
MAIN-EX.
EXIT.
EXIT-OK SECTION.
*
EXEC CICS
SEND TEXT FROM (WS-MSG)
LENGTH (LENGTH OF WS-MSG)
ERASE
FREEKB
END-EXEC
*
EXEC CICS
RETURN
END-EXEC
*
.
EXIT-OK-EX.
EXIT. |
Execution output using Dell TPE and having defined a transaction code EXQ for the program into the PCT table:
Type in “EXQ <a valid TS queue name>” and ENTER:
output:
