forked from WASdev/sample.wola
-
Notifications
You must be signed in to change notification settings - Fork 0
/
OLACB05.jclsamp
252 lines (224 loc) · 19.6 KB
/
OLACB05.jclsamp
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
//OLACB05 JOB (),'ME',
// MSGCLASS=H,NOTIFY=&SYSUID
//*
//* Compile Cobol CICS test program for OLA - Host Service
//*
//* Test invoking a CICS program and returning a response to
//* WAS usinf a COMMAREA. This a an OLA Sample.
//*
//MYPROCS JCLLIB ORDER=MVSBUILD.CICSTS32.CICS.SDFHPROC
//CMP EXEC DFHYITVL,INDEX='MVSBUILD.CICSTS32.CICS',
// PROGLIB='BOSS.OLA.SAMPLES.LOAD',
// DSCTLIB='BOSS.OLA.SAMPLES.COPYBOOK',
// AD370HLQ='MVSBUILD.COB340',
// LE370HLQ='CEE'
//TRN.SYSIN DD *
* ------------------------------------------------------------
*
* OLACB05.cob - Sample Cobol program that can be used under
* CICS, batch, and USS and demonstrates use
* of the Register, Connection Get, Send Request,
* Get Data, Connection Release, and Unregister
* APIs.
*
* Copyright IBM Corporation 2008,2014
*
* LICENSE: Apache License
* Version 2.0, January 2004
* http://www.apache.org/licenses/
*
* This sample program returns the message that was passed.
*
* OLACB05 is a basic Cobol sample program which is used
* to demonstrate using the primitive APIs that allow a
* CICS/batch program to call and EJB is WAS.
*
* The following code is sample code created by IBM Corporation.
* This sample code is not part of any standard IBM product and
* is provided to you solely for the purpose of assisting you in
* the development of your applications. The code is provided
* 'as is', without warranty or condition of any kind. IBM shall
* not be liable for any damages arising out of your use of the
* sample code, even if IBM has been advised of the possibility
* of such damages.
*
* -------------------------------------------------------------
*
* Module Name OLACB05
*
IDENTIFICATION DIVISION.
PROGRAM-ID. OLACB05.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
01 FILLER PIC X(32) VALUE
'** Working storage starts here**'.
01 daemonname PIC X(8) VALUE LOW-VALUES.
01 reqtype PIC 9(8) COMP VALUE 0.
01 rqst-area PIC X(100) VALUE SPACES.
01 rqst-area-addr USAGE POINTER.
01 resp-area PIC X(2048) VALUE SPACES.
01 resp-area-addr USAGE POINTER.
01 nodename PIC X(8) VALUE 'SY1 '.
01 servername PIC X(8) VALUE 'BBOS001 '.
01 registername PIC X(12) VALUE SPACES.
01 servicename PIC X(255).
01 minconn PIC 9(8) COMP VALUE 1.
01 maxconn PIC 9(8) COMP VALUE 10.
01 regopts PIC 9(8) COMP VALUE 0.
01 urgopts PIC 9(8) COMP VALUE 0.
01 servicenamel PIC 9(8) COMP.
01 rcs-rqst-area PIC X(100) VALUE SPACES.
01 rcs-rqst-area-addr USAGE POINTER.
01 rcs-rqst-len PIC 9(8) COMP VALUE 100.
01 get-rqst-area PIC X(100) VALUE SPACES.
01 get-rqst-area-addr USAGE POINTER.
01 srp-resp-area PIC X(2048) VALUE SPACES.
01 srp-resp-area-addr USAGE POINTER.
01 srp-resp-len PIC 9(8) COMP VALUE 100.
01 waittime PIC 9(8) USAGE BINARY.
01 async PIC 9(8) USAGE BINARY.
01 expected-len PIC 9(8) COMP VALUE 0.
01 expected-resp-area PIC X(100) VALUE SPACES.
01 tmp-len PIC 9(8) COMP VALUE 0.
01 con-handle-addr PIC X(12) VALUE LOW-VALUES.
01 rqst-len PIC 9(8) COMP VALUE 100.
01 resp-len PIC 9(8) COMP VALUE 100.
01 rc PIC 9(8) COMP VALUE 0.
01 rsn PIC 9(8) COMP VALUE 0.
01 rv PIC 9(8) COMP VALUE 0.
01 rc-urg PIC 9(8) COMP VALUE 0.
01 rsn-urg PIC 9(8) COMP VALUE 0.
01 rc-cnr PIC 9(8) COMP VALUE 0.
01 rsn-cnr PIC 9(8) COMP VALUE 0.
*
LINKAGE SECTION.
*
PROCEDURE DIVISION.
*
* Setup the parameters for Register API
*
MOVE 'OLACB05REG ' TO registername.
MOVE 'SY1' TO daemonname.
INSPECT daemonname CONVERTING ' ' TO LOW-VALUES.
*
DISPLAY "OLACB05: Calling Register (BBOA1REG)"
DISPLAY "OLACB05: Node name : " nodename
DISPLAY "OLACB05: Server name : " servername
DISPLAY "OLACB05: Register name : " registername
CALL 'BBOA1REG' USING daemonname, nodename, servername,
registername, minconn, maxconn,
regopts, rc, rsn.
IF rc > 0 THEN
DISPLAY "Bad RC/RSN from BBOA1REG: " rc "/" rsn
GOBACK
END-IF.
*
* Setup the parameters for Connection Get API
*
MOVE 0 TO async.
MOVE 0 To waittime.
CALL 'BBOA1CNG' USING registername,
con-handle-addr,
waittime,
rc, rsn.
* DISPLAY "OLACB05: Back from BBOA1CNG!: " rc "/" rsn
IF rc > 0 THEN
DISPLAY "OLACB05: Bad RC/RSN from BBOA1CNG: " rc "/" rsn
EXIT PROGRAM
END-IF.
*
* Setup the parameters for Send Request API
*
MOVE 1 TO reqtype.
*
MOVE 'java:global/OLASampleLiberty/OLASampleLibertyEJB/EchoBe
- 'an!com.ibm.websphere.ola.ExecuteLocalBusiness' TO
servicename.
* Pad the service name with 0x00s so servicenamel = 0 will
* result in the null-terminated length being calculated.
INSPECT servicename CONVERTING ' ' TO LOW-VALUES.
*
MOVE 0 TO servicenamel.
*
MOVE 'Hello from testcase OLACB05!!' TO rqst-area.
MOVE rqst-area TO expected-resp-area.
SET rqst-area-addr TO ADDRESS OF rqst-area.
* Calculate length of string in rqst-area.
INSPECT FUNCTION REVERSE(rqst-area)
- TALLYING tmp-len FOR LEADING SPACES.
COMPUTE rqst-len = LENGTH OF rqst-area - tmp-len.
MOVE rqst-len TO expected-len.
*
MOVE 0 TO async.
*
* Send Request -- call the ejb
*
DISPLAY "OLACB05: First call Send Request (BBOA1SRQ)".
DISPLAY "OLACB05: Request area len: " rqst-len.
BBOA1SRQ.
CALL 'BBOA1SRQ' USING con-handle-addr, reqtype,
servicename,
servicenamel,
rqst-area-addr, rqst-len,
async,
tmp-len,
rc, rsn.
IF rc > 0 THEN
DISPLAY "OLACB05: Bad RC/RSN from BBOA1SRQ: " rc "/" rsn
GO TO BBOA1CNR
END-IF.
DISPLAY "OLACB05: Send Request back rc/rsn: " rc "/" rsn.
BBOA1GET.
*
* Get data API call
*
SET resp-area-addr TO ADDRESS OF resp-area.
* DISPLAY "OLACB05: Calling Get Data (BBOA1GET)".
CALL 'BBOA1GET' USING con-handle-addr,
resp-area-addr, resp-len,
rc, rsn, rv.
IF rc > 0 THEN
DISPLAY "OLACB05: Bad RC/RSN from BBOA1GET: " rc "/" rsn
GO TO BBOA1CNR
END-IF.
DISPLAY "OLACB05: Get Data back rc/rsn: " rc "/" rsn.
DISPLAY "OLACB05: Response length (rv) : " rv.
IF rv NOT EQUAL expected-len THEN
DISPLAY "OLACB05: Unexpected response length: " rv
DISPLAY "OLACB05: was expecting: " expected-len
GO TO BBOA1CNR
END-IF.
IF resp-area NOT EQUAL expected-resp-area THEN
DISPLAY "OLACB05: Data did not match!!"
GO TO BBOA1CNR
END-IF.
BBOA1CNR.
*
* Connection Release
*
DISPLAY "OLACB05: Calling Connection Release (BBOA1CNR)".
CALL 'BBOA1CNR' USING
con-handle-addr,
rc-cnr, rsn-cnr.
If rc-cnr > 0 Then
DISPLAY "OLACB05: BBOA1CNR Bad RC/RSN: " rc-cnr "/" rsn-cnr.
End-IF.
BBOA1URG.
*
* UNREGISTER
*
DISPLAY "OLACB05: Calling Unregister (BBOA1URG)"
CALL 'BBOA1URG' USING registername, urgopts, rc-urg, rsn-urg.
IF rc-urg > 0 THEN
DISPLAY "OLACB05: Bad BBOA1URG RC/RSN: " rc-urg "/" rsn-urg.
END-IF.
LEAVE-OLACB05.
EXEC CICS RETURN
END-EXEC.
//LKED.SYSLIB DD DSN=BOSS.OLA91205.PERF.SBBOLOAD,DISP=SHR
// DD DSN=MVSBUILD.CICSTS32.CICS.SDFHLOAD,DISP=SHR
// DD DSN=CEE.SCEELKED,DISP=SHR
//LKED.SYSIN DD *
NAME OLACB05(R)