forked from zosconnect/zosconnect-sample-wola-batch
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathzconcbl.cbl
355 lines (339 loc) · 15.1 KB
/
zconcbl.cbl
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
IDENTIFICATION DIVISION.
PROGRAM-ID. ZCONCBL.
******************************************************************
* *
* Licensed Materials - Property of IBM *
* *
* SAMPLE *
* *
* (c) Copyright IBM Corp. 2016 All Rights Reserved *
* *
* US Government Users Restricted Rights - Use, duplication or *
* disclosure restricted by GSA ADP Schedule Contract with IBM *
* Corp *
* *
******************************************************************
* Sample Program Description *
* *
* This sample program uses the WebSphere Optimized Local *
* Adapters (WOLA) APIs to interact with a z/OS Connect EE *
* server. It supports REST HTTP verbs POST, GET, PUT and DELETE. *
* The JSON payload is mapped into a COBOL Copybook containing *
* an Employee's contact information that is stored in memory. *
* *
* The WOLA APIs used by the sample program for outbound calls *
* are described below: *
* *
* BBOA1REG - Register program with local Liberty Server *
* BBOA1SRV - Setup program as a server and target for *
* optimized local adapter calls *
* BBOA1SRP - Send the response to a request back to the local *
* Liberty Server *
* BBOA1CNR - Release connection back to the pool and made *
* available for another requester *
* BBOA1URG - Unregister from the local optimized local adapter *
* group and Liberty Server *
* *
* WOLA API Flow: *
* *
* BBOA1REG *
* | <------+ *
* BBOA1SRV | *
* | | *
* BBOA1SRP | Loop stops if action specified was not *
* | | recognized (not 'P', 'G', 'U' or 'D') *
* BBOA1CNR | *
* | -------+ *
* BBOA1URG *
* *
* Actions Supported: *
* *
* POST 'P' - Adds an employee's contact information *
* GET 'G' - Retrieves the employee's contact information *
* PUT 'U' - Updates the employee's contact information *
* DELETE 'D' - Remove the employees' contact information *
* *
******************************************************************
ENVIRONMENT DIVISION.
***********************
DATA DIVISION.
****************
WORKING-STORAGE SECTION.
**************************
*
* INCLUDE THE COPYBOOK FOR REQUEST AND RESPONSE DATA STRUCTURE
*
COPY ZCONREQ.
COPY ZCONRESP.
*
* DECLARE WORKING STORAGE VARIABLES USED IN THIS PROGRAM.
*
*---------------------------------------------------------------
* DATA-NAME DATA-TYPE
*---------------------------------------------------------------
*
* REGISTRATION VARIABLES
*
01 REG-VARIABLES.
05 REG-GRPNAME1 PIC X(8) VALUE LOW-VALUES.
05 REG-GRPNAME2 PIC X(8).
05 REG-GRPNAME3 PIC X(8).
05 REG-REGNAME PIC X(12) VALUE SPACES.
05 REG-MINCONN PIC 9(8) COMP VALUE 1.
05 REG-MAXCONN PIC 9(8) COMP VALUE 10.
05 REG-FLAGS PIC 9(8) COMP VALUE 0.
05 REG-URG-FLAGS PIC 9(8) COMP VALUE 0.
*
* SERVICE VARIABLES
*
01 SVC-VARIABLES.
05 SVC-SERVICE-NAME PIC X(255).
05 SVC-SERVICE-NAME-LENGTH PIC 9(8) COMP.
05 SVC-RQST-DATA-ADDR USAGE POINTER.
05 SVC-RQST-DATA-LENGTH PIC 9(8) COMP.
05 SVC-RESP-DATA-ADDR USAGE POINTER.
05 SVC-RESP-DATA-LENGTH PIC 9(8) COMP.
05 SVC-CONNECT-HANDLE PIC X(12).
05 SVC-WAIT-TIME PIC 9(8) USAGE BINARY.
*
* WOLA APIS RESPONSE VARIABLES
*
01 RSP-VARIABLES.
05 RSP-RC PIC 9(8) COMP VALUE 0.
05 RSP-RSN PIC 9(8) COMP VALUE 0.
05 RSP-RV PIC 9(8) COMP VALUE 0.
*
* VARIABLES FOR STORING THE DATA
*
01 STOR-DATA.
05 STOR-EMPID PIC X(05).
05 STOR-EMPNAME PIC X(25).
05 STOR-EMAIL PIC X(30).
05 STOR-PHONE PIC X(20).
05 STOR-REMARKS PIC X(40).
*
* WORKING VARIABLES
*
01 HTTP-VERB PIC X(01).
01 STOP-FLAG PIC 9(1) COMP VALUE 0.
01 CLEAR-WITH-LOW PIC X(255) VALUE LOW-VALUES.
PROCEDURE DIVISION.
*********************
MAIN-CONTROL SECTION.
*
*
* SET THE VALUES FOR USE WITH WOLA REGISTRATION
*
MOVE 'COBOLZCON' TO REG-REGNAME.
MOVE 'GRPNAME1' TO REG-GRPNAME1.
MOVE 'GRPNAME2' TO REG-GRPNAME2.
MOVE 'GRPNAME3' TO REG-GRPNAME3.
MOVE 'CobolService' TO SVC-SERVICE-NAME.
INSPECT REG-GRPNAME1 CONVERTING ' ' to LOW-VALUES.
*
* INITIALIZE THE LOCAL VARIABLES USED IN THIS PROGRAM.
*
INITIALIZE SVC-RQST-VARIABLES
SVC-RQST-DATA-LENGTH
SVC-RESP-VARIABLES
SVC-RESP-DATA-LENGTH
EXIT.
*
* Register to a Local Liberty server
* ==================================
*
CALL 'BBOA1REG' USING
REG-GRPNAME1,
REG-GRPNAME2,
REG-GRPNAME3,
REG-REGNAME,
REG-MINCONN,
REG-MAXCONN,
REG-FLAGS,
RSP-RC,
RSP-RSN.
IF RSP-RC > 0 THEN
DISPLAY "ERROR: Call to BBOA1REG failed"
GO TO Bad-RC
ELSE
DISPLAY "========================================"
DISPLAY " ***** ****** *** **** ** ** "
DISPLAY " ** *** ** ** ** ** ** ** ** "
DISPLAY " ***** ****** ******* ** ** **** "
DISPLAY " ** ** ** ** ** ** ** ** "
DISPLAY " ** ** ****** ** ** **** ** "
DISPLAY "========================================"
DISPLAY " Register Name : " REG-REGNAME
DISPLAY "========================================"
DISPLAY " Successfully registered into: "
DISPLAY " " REG-GRPNAME1 " " REG-GRPNAME2 " " REG-GRPNAME3
DISPLAY "========================================"
END-IF.
MOVE LENGTH OF SVC-RQST-VARIABLES TO SVC-RQST-DATA-LENGTH.
SET SVC-RQST-DATA-ADDR TO ADDRESS OF SVC-RQST-VARIABLES.
INSPECT SVC-SERVICE-NAME CONVERTING ' ' to LOW-VALUES.
PERFORM UNTIL STOP-FLAG EQUAL 1
PERFORM Clear-Fields
*
* Setup host service
* ==================
*
CALL 'BBOA1SRV' USING
REG-REGNAME,
SVC-SERVICE-NAME,
SVC-SERVICE-NAME-LENGTH,
SVC-RQST-DATA-ADDR,
SVC-RQST-DATA-LENGTH,
SVC-CONNECT-HANDLE,
SVC-WAIT-TIME,
RSP-RC,
RSP-RSN,
RSP-RV
DISPLAY " "
DISPLAY " Service Name : " SVC-SERVICE-NAME
DISPLAY " Data length : " SVC-RQST-DATA-LENGTH
DISPLAY " Return value length : " RSP-RV
DISPLAY " "
IF RSP-RC > 0 THEN
DISPLAY "ERROR: Call to BBOA1SRV failed"
GO TO Bad-RC
END-IF
*
* Setup the response for the requested service
* ============================================
*
DISPLAY "Service request processed"
MOVE SVC-RQST-TYPE TO HTTP-VERB
EVALUATE HTTP-VERB
WHEN 'P'
MOVE "POST" TO SVC-RESP-TYPE
MOVE SVC-RQST-DATA TO SVC-RESP-DATA
MOVE SVC-RQST-DATA TO STOR-DATA
MOVE "Record was added" TO SVC-RESP-MESSAGE
DISPLAY "-> POST action processed"
DISPLAY " " SVC-RESP-MESSAGE
DISPLAY " "
DISPLAY " - ID : " SVC-RESP-EMPID
DISPLAY " - Name : " SVC-RESP-EMPNAME
DISPLAY " - Email : " SVC-RESP-EMAIL
DISPLAY " - Phone : " SVC-RESP-PHONE
DISPLAY " - Remarks : " SVC-RESP-REMARKS
WHEN 'G'
MOVE "GET" TO SVC-RESP-TYPE
MOVE "Record was retrieved" TO SVC-RESP-MESSAGE
MOVE STOR-DATA TO SVC-RESP-DATA
DISPLAY "-> GET action processed"
DISPLAY " " SVC-RESP-MESSAGE
DISPLAY " "
DISPLAY " - ID : " SVC-RESP-EMPID
DISPLAY " - Name : " SVC-RESP-EMPNAME
DISPLAY " - Email : " SVC-RESP-EMAIL
DISPLAY " - Phone : " SVC-RESP-PHONE
DISPLAY " - Remarks : " SVC-RESP-REMARKS
WHEN 'U'
MOVE SVC-RQST-DATA TO SVC-RESP-DATA
MOVE SVC-RQST-DATA TO STOR-DATA
MOVE "PUT" TO SVC-RESP-TYPE
MOVE "Record was updated" TO SVC-RESP-MESSAGE
DISPLAY "-> UPDATE action processed"
DISPLAY " " SVC-RESP-MESSAGE
DISPLAY " "
DISPLAY " - ID : " SVC-RESP-EMPID
DISPLAY " - Name : " SVC-RESP-EMPNAME
DISPLAY " - Email : " SVC-RESP-EMAIL
DISPLAY " - Phone : " SVC-RESP-PHONE
DISPLAY " - Remarks : " SVC-RESP-REMARKS
WHEN 'D'
MOVE "DELETE" TO SVC-RESP-TYPE
MOVE "Record was deleted" TO SVC-RESP-MESSAGE
MOVE STOR-DATA TO SVC-RESP-DATA
DISPLAY "-> DELETE action processed"
DISPLAY " " SVC-RESP-MESSAGE
DISPLAY " "
DISPLAY " - ID : " SVC-RESP-EMPID
DISPLAY " - Name : " SVC-RESP-EMPNAME
DISPLAY " - Email : " SVC-RESP-EMAIL
DISPLAY " - Phone : " SVC-RESP-PHONE
DISPLAY " - Remarks : " SVC-RESP-REMARKS
MOVE '11111' TO STOR-EMPID
MOVE 'Deleted' TO STOR-EMPNAME
MOVE 'Deleted' TO STOR-EMAIL
MOVE '555-555-5555' TO STOR-PHONE
MOVE 'Deleted' TO STOR-REMARKS
WHEN OTHER
MOVE "UNKNOWN" TO SVC-RESP-TYPE
MOVE "Program terminated." TO SVC-RESP-MESSAGE
DISPLAY "-> Unknown action was specified"
DISPLAY " " SVC-RESP-MESSAGE
DISPLAY " Program will terminate ..."
MOVE 1 TO STOP-FLAG
END-EVALUATE
MOVE LENGTH OF SVC-RESP-VARIABLES TO SVC-RESP-DATA-LENGTH
SET SVC-RESP-DATA-ADDR TO ADDRESS OF SVC-RESP-VARIABLES
*
* Send response to the service request
* ====================================
*
CALL 'BBOA1SRP' USING
SVC-CONNECT-HANDLE,
SVC-RESP-DATA-ADDR,
SVC-RESP-DATA-LENGTH,
RSP-RC,
RSP-RSN
IF RSP-RC > 0 THEN
DISPLAY "ERROR: Call to BBOA1RP failed"
GO TO Bad-RC
END-IF
*
* Release WOLA connect
* ====================
*
CALL 'BBOA1CNR' USING
SVC-CONNECT-HANDLE,
RSP-RC,
RSP-RSN
IF RSP-RC > 0 THEN
DISPLAY "ERROR: Call to BBOA1CNR failed"
GO TO Bad-RC
END-IF
MOVE STOR-DATA TO SVC-RESP-DATA
END-PERFORM.
*
* Unregister service
* ==================
*
CALL 'BBOA1URG' USING
REG-REGNAME,
REG-URG-FLAGS,
RSP-RC,
RSP-RSN
IF RSP-RC > 0 THEN
DISPLAY "ERROR: Call to BBOA1URG failed"
GO TO Bad-RC
ELSE
DISPLAY " "
DISPLAY " Successfully unregistered from "
DISPLAY " " REG-GRPNAME1 " " REG-GRPNAME2 " " REG-GRPNAME3
DISPLAY " "
END-IF.
GOBACK.
*
* Clear the fields and save a copy of data
* ========================================
*
Clear-Fields.
MOVE CLEAR-WITH-LOW TO STOR-DATA
MOVE SVC-RESP-DATA TO STOR-DATA
MOVE CLEAR-WITH-LOW TO SVC-RQST-VARIABLES.
MOVE CLEAR-WITH-LOW TO SVC-RESP-VARIABLES.
*
* Section used to exit batch if any API returned RC>0
* ===================================================
*
Bad-RC.
DISPLAY " "
DISPLAY " Return Code = " RSP-RC
DISPLAY " Reason Code = " RSP-RSN
DISPLAY " "
DISPLAY " Program ended with Error "
GOBACK.